diff --git a/base/Makefile b/base/Makefile index 7efe5804e..d058f8455 100644 --- a/base/Makefile +++ b/base/Makefile @@ -4,7 +4,7 @@ HERE=. LIBDIR=../lib LIBNAME=$(BASELIBNAME) LIBMOD=psb_base_mod$(.mod) -lib: mods sr cm in pb tl +lib: mods sr cm in pb tl /bin/cp -p $(CPUPDFLAG) $(HERE)/$(LIBNAME) $(LIBDIR) /bin/cp -p $(CPUPDFLAG) $(LIBMOD) *$(.mod) $(LIBDIR) diff --git a/base/comm/psb_cgather.f90 b/base/comm/psb_cgather.f90 index 05f5f2497..37814cd93 100644 --- a/base/comm/psb_cgather.f90 +++ b/base/comm/psb_cgather.f90 @@ -131,7 +131,7 @@ subroutine psb_cgatherm(globx, locx, desc_a, info, iroot) goto 9999 end if - globx(:,:)=0.d0 + globx(:,:)=czero do j=1,k do i=1,desc_a%get_local_rows() @@ -294,8 +294,8 @@ subroutine psb_cgatherv(globx, locx, desc_a, info, iroot) call psb_errpush(info,name) goto 9999 end if - - globx(:)=0.d0 + + globx(:)=czero do i=1,desc_a%get_local_rows() call psb_loc_to_glob(i,idx,desc_a,info) @@ -326,3 +326,115 @@ subroutine psb_cgatherv(globx, locx, desc_a, info, iroot) return end subroutine psb_cgatherv + + + +subroutine psb_cgather_vect(globx, locx, desc_a, info, iroot) + use psb_base_mod, psb_protect_name => psb_cgather_vect + implicit none + + type(psb_c_vect_type), intent(in) :: locx + complex(psb_spk_), intent(out) :: globx(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, intent(in), optional :: iroot + + + ! locals + integer :: int_err(5), ictxt, np, me, & + & err_act, n, root, ilocx, iglobx, jlocx,& + & jglobx, lda_locx, lda_globx, m, k, jlx, ilx, i, idx + complex(psb_spk_), allocatable :: llocx(:) + character(len=20) :: name, ch_err + + name='psb_cgatherv' + if(psb_get_errstatus() /= 0) return + info=psb_success_ + call psb_erractionsave(err_act) + + ictxt=desc_a%get_context() + + ! check on blacs grid + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (present(iroot)) then + root = iroot + if((root < -1).or.(root > np)) then + info=psb_err_input_value_invalid_i_ + int_err(1:2)=(/5,root/) + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + else + root = -1 + end if + + jglobx=1 + iglobx = 1 + jlocx=1 + ilocx = 1 + + lda_globx = size(globx) + lda_locx = locx%get_nrows() + + m = desc_a%get_global_rows() + n = desc_a%get_global_cols() + + k = 1 + + + ! there should be a global check on k here!!! + + call psb_chkglobvect(m,n,size(globx),iglobx,jglobx,desc_a,info) + if (info == psb_success_) & + & call psb_chkvect(m,n,locx%get_nrows(),ilocx,jlocx,desc_a,info,ilx,jlx) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chk(glob)vect' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if ((ilx /= 1).or.(iglobx /= 1)) then + info=psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + goto 9999 + end if + + globx(:)=czero + llocx = locx + + do i=1,desc_a%get_local_rows() + call psb_loc_to_glob(i,idx,desc_a,info) + globx(idx) = llocx(i) + end do + + ! adjust overlapped elements + do i=1, size(desc_a%ovrlap_elem,1) + if (me /= desc_a%ovrlap_elem(i,3)) then + idx = desc_a%ovrlap_elem(i,1) + call psb_loc_to_glob(idx,desc_a,info) + globx(idx) = czero + end if + end do + + call psb_sum(ictxt,globx(1:m),root=root) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end subroutine psb_cgather_vect diff --git a/base/comm/psb_chalo.f90 b/base/comm/psb_chalo.f90 index 1a2e3de76..479b12b67 100644 --- a/base/comm/psb_chalo.f90 +++ b/base/comm/psb_chalo.f90 @@ -150,7 +150,7 @@ subroutine psb_chalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data) if(present(alpha)) then if(alpha /= 1.d0) then do i=0, k-1 - call zscal(nrow,alpha,x(:,jjx+i),1) + call cscal(nrow,alpha,x(:,jjx+i),1) end do end if end if @@ -197,7 +197,7 @@ subroutine psb_chalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data) end if if(info /= psb_success_) then - ch_err='PSI_zswapdata' + ch_err='PSI_cswapdata' call psb_errpush(psb_err_from_subroutine_,name,a_err=ch_err) goto 9999 end if @@ -323,17 +323,16 @@ subroutine psb_chalov(x,desc_a,info,alpha,work,tran,mode,data) else tran_ = 'N' endif - if (present(mode)) then - imode = mode - else - imode = IOR(psb_swap_send_,psb_swap_recv_) - endif - if (present(data)) then data_ = data else data_ = psb_comm_halo_ endif + if (present(mode)) then + imode = mode + else + imode = IOR(psb_swap_send_,psb_swap_recv_) + endif ! check vector correctness call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx) @@ -354,7 +353,7 @@ subroutine psb_chalov(x,desc_a,info,alpha,work,tran,mode,data) if(present(alpha)) then if(alpha /= 1.d0) then - call zscal(nrow,alpha,x,ione) + call cscal(nrow,alpha,x,ione) end if end if @@ -398,7 +397,7 @@ subroutine psb_chalov(x,desc_a,info,alpha,work,tran,mode,data) end if if(info /= psb_success_) then - ch_err='PSI_dSwap...' + ch_err='PSI_swapdata' call psb_errpush(psb_err_from_subroutine_,name,a_err=ch_err) goto 9999 end if @@ -420,4 +419,152 @@ subroutine psb_chalov(x,desc_a,info,alpha,work,tran,mode,data) end subroutine psb_chalov +subroutine psb_chalo_vect(x,desc_a,info,alpha,work,tran,mode,data) + use psb_base_mod, psb_protect_name => psb_chalo_vect + use psi_mod + implicit none + type(psb_c_vect_type), intent(inout) :: x + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + complex(psb_spk_), intent(in), optional :: alpha + complex(psb_spk_), target, optional, intent(inout) :: work(:) + integer, intent(in), optional :: mode,data + character, intent(in), optional :: tran + + ! locals + integer :: ictxt, np, me,& + & err_act, m, n, iix, jjx, ix, ijx, nrow, imode,& + & err, liwork,data_ + complex(psb_spk_),pointer :: iwork(:) + character :: tran_ + character(len=20) :: name, ch_err + logical :: aliw + + name='psb_chalov' + if(psb_get_errstatus() /= 0) return + info=psb_success_ + call psb_erractionsave(err_act) + + ictxt=desc_a%get_context() + + ! check on blacs grid + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + ix = 1 + ijx = 1 + + m = desc_a%get_global_rows() + n = desc_a%get_global_cols() + nrow = desc_a%get_local_rows() + + if (present(tran)) then + tran_ = psb_toupper(tran) + else + tran_ = 'N' + endif + if (present(data)) then + data_ = data + else + data_ = psb_comm_halo_ + endif + if (present(mode)) then + imode = mode + else + imode = IOR(psb_swap_send_,psb_swap_recv_) + endif + + ! check vector correctness + call psb_chkvect(m,1,x%get_nrows(),ix,ijx,desc_a,info,iix,jjx) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect' + call psb_errpush(info,name,a_err=ch_err) + end if + + if (iix /= 1) then + info=psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + end if + + err=info + call psb_errcomm(ictxt,err) + if(err /= 0) goto 9999 + + if(present(alpha)) then + if(alpha /= 1.0) then + call x%scal(alpha) + end if + end if + + liwork=nrow + if (present(work)) then + if(size(work) >= liwork) then + iwork => work + aliw=.false. + else + aliw=.true. + allocate(iwork(liwork),stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_realloc' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + end if + else + aliw=.true. + allocate(iwork(liwork),stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_realloc' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + end if + + ! exchange halo elements + if(tran_ == 'N') then + call psi_swapdata(imode,czero,x%v,& + & desc_a,iwork,info,data=data_) + else if((tran_ == 'T').or.(tran_ == 'C')) then + call psi_swaptran(imode,cone,x%v,& + & desc_a,iwork,info) + else + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='invalid tran') + goto 9999 + end if + + if(info /= psb_success_) then + ch_err='PSI_swapdata' + call psb_errpush(psb_err_from_subroutine_,name,a_err=ch_err) + goto 9999 + end if + + if (aliw) deallocate(iwork) + nullify(iwork) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return +end subroutine psb_chalo_vect diff --git a/base/comm/psb_covrl.f90 b/base/comm/psb_covrl.f90 index 050396592..d39cee14e 100644 --- a/base/comm/psb_covrl.f90 +++ b/base/comm/psb_covrl.f90 @@ -164,6 +164,7 @@ subroutine psb_covrlm(x,desc_a,info,jx,ik,work,update,mode) else aliw=.true. end if + if (aliw) then allocate(iwork(liwork),stat=info) if(info /= psb_success_) then @@ -386,3 +387,134 @@ subroutine psb_covrlv(x,desc_a,info,work,update,mode) end if return end subroutine psb_covrlv + + +subroutine psb_covrl_vect(x,desc_a,info,work,update,mode) + use psb_base_mod, psb_protect_name => psb_covrl_vect + use psi_mod + implicit none + + type(psb_c_vect_type), intent(inout) :: x + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + complex(psb_spk_), optional, target, intent(inout) :: work(:) + integer, intent(in), optional :: update,mode + + ! locals + integer :: ictxt, np, me, & + & err_act, m, n, iix, jjx, ix, ijx, nrow, ncol, k, update_,& + & mode_, err, liwork + complex(psb_spk_),pointer :: iwork(:) + logical :: do_swap + character(len=20) :: name, ch_err + logical :: aliw + + name='psb_covrlv' + if(psb_get_errstatus() /= 0) return + info=psb_success_ + call psb_erractionsave(err_act) + + ictxt=desc_a%get_context() + + ! check on blacs grid + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + ix = 1 + ijx = 1 + + m = desc_a%get_global_rows() + n = desc_a%get_global_cols() + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + + k = 1 + + if (present(update)) then + update_ = update + else + update_ = psb_avg_ + endif + + if (present(mode)) then + mode_ = mode + else + mode_ = IOR(psb_swap_send_,psb_swap_recv_) + endif + do_swap = (mode_ /= 0) + + ! check vector correctness + call psb_chkvect(m,1,x%get_nrows(),ix,ijx,desc_a,info,iix,jjx) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect' + call psb_errpush(info,name,a_err=ch_err) + end if + + if (iix /= 1) then + info=psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + end if + + err=info + call psb_errcomm(ictxt,err) + if(err /= 0) goto 9999 + + ! check for presence/size of a work area + liwork=ncol + if (present(work)) then + if(size(work) >= liwork) then + aliw=.false. + else + aliw=.true. + end if + else + aliw=.true. + end if + if (aliw) then + allocate(iwork(liwork),stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='Allocate') + goto 9999 + end if + else + iwork => work + end if + + ! exchange overlap elements + if (do_swap) then + call psi_swapdata(mode_,cone,x%v,& + & desc_a,iwork,info,data=psb_comm_ovr_) + end if + if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,update_,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='Inner updates') + goto 9999 + end if + + if (aliw) deallocate(iwork) + nullify(iwork) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return +end subroutine psb_covrl_vect + diff --git a/base/comm/psb_dgather.f90 b/base/comm/psb_dgather.f90 index 9020fc6e8..f24255ce9 100644 --- a/base/comm/psb_dgather.f90 +++ b/base/comm/psb_dgather.f90 @@ -325,3 +325,115 @@ subroutine psb_dgatherv(globx, locx, desc_a, info, iroot) return end subroutine psb_dgatherv + + + +subroutine psb_dgather_vect(globx, locx, desc_a, info, iroot) + use psb_base_mod, psb_protect_name => psb_dgather_vect + implicit none + + type(psb_d_vect_type), intent(in) :: locx + real(psb_dpk_), intent(out) :: globx(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, intent(in), optional :: iroot + + + ! locals + integer :: int_err(5), ictxt, np, me, & + & err_act, n, root, ilocx, iglobx, jlocx,& + & jglobx, lda_locx, lda_globx, m, k, jlx, ilx, i, idx + real(psb_dpk_), allocatable :: llocx(:) + character(len=20) :: name, ch_err + + name='psb_dgatherv' + if(psb_get_errstatus() /= 0) return + info=psb_success_ + call psb_erractionsave(err_act) + + ictxt=desc_a%get_context() + + ! check on blacs grid + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (present(iroot)) then + root = iroot + if((root < -1).or.(root > np)) then + info=psb_err_input_value_invalid_i_ + int_err(1:2)=(/5,root/) + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + else + root = -1 + end if + + jglobx=1 + iglobx = 1 + jlocx=1 + ilocx = 1 + + lda_globx = size(globx) + lda_locx = locx%get_nrows() + + m = desc_a%get_global_rows() + n = desc_a%get_global_cols() + + k = 1 + + + ! there should be a global check on k here!!! + + call psb_chkglobvect(m,n,size(globx),iglobx,jglobx,desc_a,info) + if (info == psb_success_) & + & call psb_chkvect(m,n,locx%get_nrows(),ilocx,jlocx,desc_a,info,ilx,jlx) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chk(glob)vect' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if ((ilx /= 1).or.(iglobx /= 1)) then + info=psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + goto 9999 + end if + + globx(:)=dzero + llocx = locx + + do i=1,desc_a%get_local_rows() + call psb_loc_to_glob(i,idx,desc_a,info) + globx(idx) = llocx(i) + end do + + ! adjust overlapped elements + do i=1, size(desc_a%ovrlap_elem,1) + if (me /= desc_a%ovrlap_elem(i,3)) then + idx = desc_a%ovrlap_elem(i,1) + call psb_loc_to_glob(idx,desc_a,info) + globx(idx) = dzero + end if + end do + + call psb_sum(ictxt,globx(1:m),root=root) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end subroutine psb_dgather_vect diff --git a/base/comm/psb_dhalo.f90 b/base/comm/psb_dhalo.f90 index 211d8d56e..141736913 100644 --- a/base/comm/psb_dhalo.f90 +++ b/base/comm/psb_dhalo.f90 @@ -417,5 +417,151 @@ subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode,data) return end subroutine psb_dhalov +subroutine psb_dhalo_vect(x,desc_a,info,alpha,work,tran,mode,data) + use psb_base_mod, psb_protect_name => psb_dhalo_vect + use psi_mod + implicit none + type(psb_d_vect_type), intent(inout) :: x + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + real(psb_dpk_), intent(in), optional :: alpha + real(psb_dpk_), target, optional, intent(inout) :: work(:) + integer, intent(in), optional :: mode,data + character, intent(in), optional :: tran + ! locals + integer :: ictxt, np, me,& + & err_act, m, n, iix, jjx, ix, ijx, nrow, imode,& + & err, liwork,data_ + real(psb_dpk_),pointer :: iwork(:) + character :: tran_ + character(len=20) :: name, ch_err + logical :: aliw + + name='psb_dhalov' + if(psb_get_errstatus() /= 0) return + info=psb_success_ + call psb_erractionsave(err_act) + + ictxt=desc_a%get_context() + + ! check on blacs grid + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + ix = 1 + ijx = 1 + + m = desc_a%get_global_rows() + n = desc_a%get_global_cols() + nrow = desc_a%get_local_rows() + + if (present(tran)) then + tran_ = psb_toupper(tran) + else + tran_ = 'N' + endif + if (present(data)) then + data_ = data + else + data_ = psb_comm_halo_ + endif + if (present(mode)) then + imode = mode + else + imode = IOR(psb_swap_send_,psb_swap_recv_) + endif + + ! check vector correctness + call psb_chkvect(m,1,x%get_nrows(),ix,ijx,desc_a,info,iix,jjx) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect' + call psb_errpush(info,name,a_err=ch_err) + end if + + if (iix /= 1) then + info=psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + end if + + err=info + call psb_errcomm(ictxt,err) + if(err /= 0) goto 9999 + + if(present(alpha)) then + if(alpha /= 1.d0) then + call x%scal(alpha) + end if + end if + + liwork=nrow + if (present(work)) then + if(size(work) >= liwork) then + iwork => work + aliw=.false. + else + aliw=.true. + allocate(iwork(liwork),stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_realloc' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + end if + else + aliw=.true. + allocate(iwork(liwork),stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_realloc' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + end if + + ! exchange halo elements + if(tran_ == 'N') then + call psi_swapdata(imode,dzero,x%v,& + & desc_a,iwork,info,data=data_) + else if((tran_ == 'T').or.(tran_ == 'C')) then + call psi_swaptran(imode,done,x%v,& + & desc_a,iwork,info) + else + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='invalid tran') + goto 9999 + end if + + if(info /= psb_success_) then + ch_err='PSI_swapdata' + call psb_errpush(psb_err_from_subroutine_,name,a_err=ch_err) + goto 9999 + end if + + if (aliw) deallocate(iwork) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return +end subroutine psb_dhalo_vect diff --git a/base/comm/psb_dovrl.f90 b/base/comm/psb_dovrl.f90 index 1a1b0495d..c64ba0f7c 100644 --- a/base/comm/psb_dovrl.f90 +++ b/base/comm/psb_dovrl.f90 @@ -388,3 +388,133 @@ subroutine psb_dovrlv(x,desc_a,info,work,update,mode) end if return end subroutine psb_dovrlv + +subroutine psb_dovrl_vect(x,desc_a,info,work,update,mode) + use psb_base_mod, psb_protect_name => psb_dovrl_vect + use psi_mod + implicit none + + type(psb_d_vect_type), intent(inout) :: x + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + real(psb_dpk_), optional, target, intent(inout) :: work(:) + integer, intent(in), optional :: update,mode + + ! locals + integer :: ictxt, np, me, & + & err_act, m, n, iix, jjx, ix, ijx, nrow, ncol, k, update_,& + & mode_, err, liwork + real(psb_dpk_),pointer :: iwork(:) + logical :: do_swap + character(len=20) :: name, ch_err + logical :: aliw + + name='psb_dovrlv' + if(psb_get_errstatus() /= 0) return + info=psb_success_ + call psb_erractionsave(err_act) + + ictxt=desc_a%get_context() + + ! check on blacs grid + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + ix = 1 + ijx = 1 + + m = desc_a%get_global_rows() + n = desc_a%get_global_cols() + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + + k = 1 + + if (present(update)) then + update_ = update + else + update_ = psb_avg_ + endif + + if (present(mode)) then + mode_ = mode + else + mode_ = IOR(psb_swap_send_,psb_swap_recv_) + endif + do_swap = (mode_ /= 0) + + ! check vector correctness + call psb_chkvect(m,1,x%get_nrows(),ix,ijx,desc_a,info,iix,jjx) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect' + call psb_errpush(info,name,a_err=ch_err) + end if + + if (iix /= 1) then + info=psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + end if + + err=info + call psb_errcomm(ictxt,err) + if(err /= 0) goto 9999 + + ! check for presence/size of a work area + liwork=ncol + if (present(work)) then + if(size(work) >= liwork) then + aliw=.false. + else + aliw=.true. + end if + else + aliw=.true. + end if + if (aliw) then + allocate(iwork(liwork),stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='Allocate') + goto 9999 + end if + else + iwork => work + end if + + ! exchange overlap elements + if (do_swap) then + call psi_swapdata(mode_,done,x%v,& + & desc_a,iwork,info,data=psb_comm_ovr_) + end if + if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,update_,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='Inner updates') + goto 9999 + end if + + if (aliw) deallocate(iwork) + nullify(iwork) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return +end subroutine psb_dovrl_vect + diff --git a/base/comm/psb_sgather.f90 b/base/comm/psb_sgather.f90 index ab78c1199..a6a780ec0 100644 --- a/base/comm/psb_sgather.f90 +++ b/base/comm/psb_sgather.f90 @@ -131,7 +131,7 @@ subroutine psb_sgatherm(globx, locx, desc_a, info, iroot) goto 9999 end if - globx(:,:)=0.d0 + globx(:,:)=szero do j=1,k do i=1,desc_a%get_local_rows() @@ -294,7 +294,7 @@ subroutine psb_sgatherv(globx, locx, desc_a, info, iroot) goto 9999 end if - globx(:)=0.d0 + globx(:)=szero do i=1,desc_a%get_local_rows() call psb_loc_to_glob(i,idx,desc_a,info) @@ -325,3 +325,115 @@ subroutine psb_sgatherv(globx, locx, desc_a, info, iroot) return end subroutine psb_sgatherv + + + +subroutine psb_sgather_vect(globx, locx, desc_a, info, iroot) + use psb_base_mod, psb_protect_name => psb_sgather_vect + implicit none + + type(psb_s_vect_type), intent(in) :: locx + real(psb_spk_), intent(out) :: globx(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, intent(in), optional :: iroot + + + ! locals + integer :: int_err(5), ictxt, np, me, & + & err_act, n, root, ilocx, iglobx, jlocx,& + & jglobx, lda_locx, lda_globx, m, k, jlx, ilx, i, idx + real(psb_spk_), allocatable :: llocx(:) + character(len=20) :: name, ch_err + + name='psb_dgatherv' + if(psb_get_errstatus() /= 0) return + info=psb_success_ + call psb_erractionsave(err_act) + + ictxt=desc_a%get_context() + + ! check on blacs grid + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (present(iroot)) then + root = iroot + if((root < -1).or.(root > np)) then + info=psb_err_input_value_invalid_i_ + int_err(1:2)=(/5,root/) + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + else + root = -1 + end if + + jglobx=1 + iglobx = 1 + jlocx=1 + ilocx = 1 + + lda_globx = size(globx) + lda_locx = locx%get_nrows() + + m = desc_a%get_global_rows() + n = desc_a%get_global_cols() + + k = 1 + + + ! there should be a global check on k here!!! + + call psb_chkglobvect(m,n,size(globx),iglobx,jglobx,desc_a,info) + if (info == psb_success_) & + & call psb_chkvect(m,n,locx%get_nrows(),ilocx,jlocx,desc_a,info,ilx,jlx) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chk(glob)vect' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if ((ilx /= 1).or.(iglobx /= 1)) then + info=psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + goto 9999 + end if + + globx(:)=szero + llocx = locx + + do i=1,desc_a%get_local_rows() + call psb_loc_to_glob(i,idx,desc_a,info) + globx(idx) = llocx(i) + end do + + ! adjust overlapped elements + do i=1, size(desc_a%ovrlap_elem,1) + if (me /= desc_a%ovrlap_elem(i,3)) then + idx = desc_a%ovrlap_elem(i,1) + call psb_loc_to_glob(idx,desc_a,info) + globx(idx) = szero + end if + end do + + call psb_sum(ictxt,globx(1:m),root=root) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end subroutine psb_sgather_vect diff --git a/base/comm/psb_shalo.f90 b/base/comm/psb_shalo.f90 index 106238133..9f8236eb5 100644 --- a/base/comm/psb_shalo.f90 +++ b/base/comm/psb_shalo.f90 @@ -118,6 +118,11 @@ subroutine psb_shalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data) else tran_ = 'N' endif + if (present(mode)) then + imode = mode + else + imode = IOR(psb_swap_send_,psb_swap_recv_) + endif if (present(data)) then data_ = data @@ -125,13 +130,6 @@ subroutine psb_shalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data) data_ = psb_comm_halo_ endif - - if (present(mode)) then - imode = mode - else - imode = IOR(psb_swap_send_,psb_swap_recv_) - endif - ! check vector correctness call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx) if(info /= psb_success_) then @@ -152,7 +150,7 @@ subroutine psb_shalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data) if(present(alpha)) then if(alpha /= 1.d0) then do i=0, k-1 - call dscal(nrow,alpha,x(:,jjx+i),1) + call sscal(nrow,alpha,x(:,jjx+i),1) end do end if end if @@ -160,8 +158,8 @@ subroutine psb_shalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data) liwork=nrow if (present(work)) then if(size(work) >= liwork) then - iwork => work aliw=.false. + iwork => work else aliw=.true. allocate(iwork(liwork),stat=info) @@ -199,12 +197,13 @@ subroutine psb_shalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data) end if if(info /= psb_success_) then - ch_err='PSI_dSwapdata' + ch_err='PSI_sSwapdata' call psb_errpush(psb_err_from_subroutine_,name,a_err=ch_err) goto 9999 end if if (aliw) deallocate(iwork) + nullify(iwork) call psb_erractionrestore(err_act) return @@ -353,15 +352,15 @@ subroutine psb_shalov(x,desc_a,info,alpha,work,tran,mode,data) if(present(alpha)) then if(alpha /= 1.d0) then - call dscal(nrow,alpha,x,ione) + call sscal(nrow,alpha,x,ione) end if end if liwork=nrow if (present(work)) then if(size(work) >= liwork) then - iwork => work aliw=.false. + iwork => work else aliw=.true. allocate(iwork(liwork),stat=info) @@ -403,6 +402,7 @@ subroutine psb_shalov(x,desc_a,info,alpha,work,tran,mode,data) end if if (aliw) deallocate(iwork) + nullify(iwork) call psb_erractionrestore(err_act) return @@ -418,4 +418,152 @@ subroutine psb_shalov(x,desc_a,info,alpha,work,tran,mode,data) end subroutine psb_shalov +subroutine psb_shalo_vect(x,desc_a,info,alpha,work,tran,mode,data) + use psb_base_mod, psb_protect_name => psb_shalo_vect + use psi_mod + implicit none + type(psb_s_vect_type), intent(inout) :: x + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + real(psb_spk_), intent(in), optional :: alpha + real(psb_spk_), target, optional, intent(inout) :: work(:) + integer, intent(in), optional :: mode,data + character, intent(in), optional :: tran + + ! locals + integer :: ictxt, np, me,& + & err_act, m, n, iix, jjx, ix, ijx, nrow, imode,& + & err, liwork,data_ + real(psb_spk_),pointer :: iwork(:) + character :: tran_ + character(len=20) :: name, ch_err + logical :: aliw + + name='psb_shalov' + if(psb_get_errstatus() /= 0) return + info=psb_success_ + call psb_erractionsave(err_act) + + ictxt=desc_a%get_context() + + ! check on blacs grid + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + ix = 1 + ijx = 1 + + m = desc_a%get_global_rows() + n = desc_a%get_global_cols() + nrow = desc_a%get_local_rows() + + if (present(tran)) then + tran_ = psb_toupper(tran) + else + tran_ = 'N' + endif + if (present(data)) then + data_ = data + else + data_ = psb_comm_halo_ + endif + if (present(mode)) then + imode = mode + else + imode = IOR(psb_swap_send_,psb_swap_recv_) + endif + + ! check vector correctness + call psb_chkvect(m,1,x%get_nrows(),ix,ijx,desc_a,info,iix,jjx) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect' + call psb_errpush(info,name,a_err=ch_err) + end if + + if (iix /= 1) then + info=psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + end if + + err=info + call psb_errcomm(ictxt,err) + if(err /= 0) goto 9999 + + if(present(alpha)) then + if(alpha /= 1.0) then + call x%scal(alpha) + end if + end if + + liwork=nrow + if (present(work)) then + if(size(work) >= liwork) then + iwork => work + aliw=.false. + else + aliw=.true. + allocate(iwork(liwork),stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_realloc' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + end if + else + aliw=.true. + allocate(iwork(liwork),stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_realloc' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + end if + + ! exchange halo elements + if(tran_ == 'N') then + call psi_swapdata(imode,szero,x%v,& + & desc_a,iwork,info,data=data_) + else if((tran_ == 'T').or.(tran_ == 'C')) then + call psi_swaptran(imode,sone,x%v,& + & desc_a,iwork,info) + else + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='invalid tran') + goto 9999 + end if + + if(info /= psb_success_) then + ch_err='PSI_swapdata' + call psb_errpush(psb_err_from_subroutine_,name,a_err=ch_err) + goto 9999 + end if + + if (aliw) deallocate(iwork) + nullify(iwork) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return +end subroutine psb_shalo_vect diff --git a/base/comm/psb_sovrl.f90 b/base/comm/psb_sovrl.f90 index b9f97e9c8..2b4e5a3d8 100644 --- a/base/comm/psb_sovrl.f90 +++ b/base/comm/psb_sovrl.f90 @@ -172,7 +172,7 @@ subroutine psb_sovrlm(x,desc_a,info,jx,ik,work,update,mode) goto 9999 end if else - iwork => work + iwork => work end if ! exchange overlap elements if(do_swap) then @@ -388,3 +388,134 @@ subroutine psb_sovrlv(x,desc_a,info,work,update,mode) end if return end subroutine psb_sovrlv + + +subroutine psb_sovrl_vect(x,desc_a,info,work,update,mode) + use psb_base_mod, psb_protect_name => psb_sovrl_vect + use psi_mod + implicit none + + type(psb_s_vect_type), intent(inout) :: x + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + real(psb_spk_), optional, target, intent(inout) :: work(:) + integer, intent(in), optional :: update,mode + + ! locals + integer :: ictxt, np, me, & + & err_act, m, n, iix, jjx, ix, ijx, nrow, ncol, k, update_,& + & mode_, err, liwork + real(psb_spk_),pointer :: iwork(:) + logical :: do_swap + character(len=20) :: name, ch_err + logical :: aliw + + name='psb_sovrlv' + if(psb_get_errstatus() /= 0) return + info=psb_success_ + call psb_erractionsave(err_act) + + ictxt=desc_a%get_context() + + ! check on blacs grid + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + ix = 1 + ijx = 1 + + m = desc_a%get_global_rows() + n = desc_a%get_global_cols() + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + + k = 1 + + if (present(update)) then + update_ = update + else + update_ = psb_avg_ + endif + + if (present(mode)) then + mode_ = mode + else + mode_ = IOR(psb_swap_send_,psb_swap_recv_) + endif + do_swap = (mode_ /= 0) + + ! check vector correctness + call psb_chkvect(m,1,x%get_nrows(),ix,ijx,desc_a,info,iix,jjx) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect' + call psb_errpush(info,name,a_err=ch_err) + end if + + if (iix /= 1) then + info=psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + end if + + err=info + call psb_errcomm(ictxt,err) + if(err /= 0) goto 9999 + + ! check for presence/size of a work area + liwork=ncol + if (present(work)) then + if(size(work) >= liwork) then + aliw=.false. + else + aliw=.true. + end if + else + aliw=.true. + end if + if (aliw) then + allocate(iwork(liwork),stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='Allocate') + goto 9999 + end if + else + iwork => work + end if + + ! exchange overlap elements + if (do_swap) then + call psi_swapdata(mode_,sone,x%v,& + & desc_a,iwork,info,data=psb_comm_ovr_) + end if + if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,update_,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='Inner updates') + goto 9999 + end if + + if (aliw) deallocate(iwork) + nullify(iwork) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return +end subroutine psb_sovrl_vect + diff --git a/base/comm/psb_zgather.f90 b/base/comm/psb_zgather.f90 index 028377836..3159f08e9 100644 --- a/base/comm/psb_zgather.f90 +++ b/base/comm/psb_zgather.f90 @@ -131,7 +131,7 @@ subroutine psb_zgatherm(globx, locx, desc_a, info, iroot) goto 9999 end if - globx(:,:)=0.d0 + globx(:,:)=zzero do j=1,k do i=1,desc_a%get_local_rows() @@ -294,8 +294,8 @@ subroutine psb_zgatherv(globx, locx, desc_a, info, iroot) call psb_errpush(info,name) goto 9999 end if - - globx(:)=0.d0 + + globx(:)=zzero do i=1,desc_a%get_local_rows() call psb_loc_to_glob(i,idx,desc_a,info) @@ -326,3 +326,115 @@ subroutine psb_zgatherv(globx, locx, desc_a, info, iroot) return end subroutine psb_zgatherv + + + +subroutine psb_zgather_vect(globx, locx, desc_a, info, iroot) + use psb_base_mod, psb_protect_name => psb_zgather_vect + implicit none + + type(psb_z_vect_type), intent(in) :: locx + complex(psb_dpk_), intent(out) :: globx(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, intent(in), optional :: iroot + + + ! locals + integer :: int_err(5), ictxt, np, me, & + & err_act, n, root, ilocx, iglobx, jlocx,& + & jglobx, lda_locx, lda_globx, m, k, jlx, ilx, i, idx + complex(psb_dpk_), allocatable :: llocx(:) + character(len=20) :: name, ch_err + + name='psb_cgatherv' + if(psb_get_errstatus() /= 0) return + info=psb_success_ + call psb_erractionsave(err_act) + + ictxt=desc_a%get_context() + + ! check on blacs grid + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (present(iroot)) then + root = iroot + if((root < -1).or.(root > np)) then + info=psb_err_input_value_invalid_i_ + int_err(1:2)=(/5,root/) + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + else + root = -1 + end if + + jglobx=1 + iglobx = 1 + jlocx=1 + ilocx = 1 + + lda_globx = size(globx) + lda_locx = locx%get_nrows() + + m = desc_a%get_global_rows() + n = desc_a%get_global_cols() + + k = 1 + + + ! there should be a global check on k here!!! + + call psb_chkglobvect(m,n,size(globx),iglobx,jglobx,desc_a,info) + if (info == psb_success_) & + & call psb_chkvect(m,n,locx%get_nrows(),ilocx,jlocx,desc_a,info,ilx,jlx) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chk(glob)vect' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if ((ilx /= 1).or.(iglobx /= 1)) then + info=psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + goto 9999 + end if + + globx(:)=zzero + llocx = locx + + do i=1,desc_a%get_local_rows() + call psb_loc_to_glob(i,idx,desc_a,info) + globx(idx) = llocx(i) + end do + + ! adjust overlapped elements + do i=1, size(desc_a%ovrlap_elem,1) + if (me /= desc_a%ovrlap_elem(i,3)) then + idx = desc_a%ovrlap_elem(i,1) + call psb_loc_to_glob(idx,desc_a,info) + globx(idx) = zzero + end if + end do + + call psb_sum(ictxt,globx(1:m),root=root) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end subroutine psb_zgather_vect diff --git a/base/comm/psb_zhalo.f90 b/base/comm/psb_zhalo.f90 index 1cfc755ce..e932ed7bd 100644 --- a/base/comm/psb_zhalo.f90 +++ b/base/comm/psb_zhalo.f90 @@ -323,17 +323,16 @@ subroutine psb_zhalov(x,desc_a,info,alpha,work,tran,mode,data) else tran_ = 'N' endif - if (present(mode)) then - imode = mode - else - imode = IOR(psb_swap_send_,psb_swap_recv_) - endif - if (present(data)) then data_ = data else data_ = psb_comm_halo_ endif + if (present(mode)) then + imode = mode + else + imode = IOR(psb_swap_send_,psb_swap_recv_) + endif ! check vector correctness call psb_chkvect(m,1,size(x,1),ix,ijx,desc_a,info,iix,jjx) @@ -398,7 +397,7 @@ subroutine psb_zhalov(x,desc_a,info,alpha,work,tran,mode,data) end if if(info /= psb_success_) then - ch_err='PSI_dSwap...' + ch_err='PSI_swapdata' call psb_errpush(psb_err_from_subroutine_,name,a_err=ch_err) goto 9999 end if @@ -420,4 +419,152 @@ subroutine psb_zhalov(x,desc_a,info,alpha,work,tran,mode,data) end subroutine psb_zhalov +subroutine psb_zhalo_vect(x,desc_a,info,alpha,work,tran,mode,data) + use psb_base_mod, psb_protect_name => psb_zhalo_vect + use psi_mod + implicit none + type(psb_z_vect_type), intent(inout) :: x + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + complex(psb_dpk_), intent(in), optional :: alpha + complex(psb_dpk_), target, optional, intent(inout) :: work(:) + integer, intent(in), optional :: mode,data + character, intent(in), optional :: tran + + ! locals + integer :: ictxt, np, me,& + & err_act, m, n, iix, jjx, ix, ijx, nrow, imode,& + & err, liwork,data_ + complex(psb_dpk_),pointer :: iwork(:) + character :: tran_ + character(len=20) :: name, ch_err + logical :: aliw + + name='psb_zhalov' + if(psb_get_errstatus() /= 0) return + info=psb_success_ + call psb_erractionsave(err_act) + + ictxt=desc_a%get_context() + + ! check on blacs grid + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + ix = 1 + ijx = 1 + + m = desc_a%get_global_rows() + n = desc_a%get_global_cols() + nrow = desc_a%get_local_rows() + + if (present(tran)) then + tran_ = psb_toupper(tran) + else + tran_ = 'N' + endif + if (present(data)) then + data_ = data + else + data_ = psb_comm_halo_ + endif + if (present(mode)) then + imode = mode + else + imode = IOR(psb_swap_send_,psb_swap_recv_) + endif + + ! check vector correctness + call psb_chkvect(m,1,x%get_nrows(),ix,ijx,desc_a,info,iix,jjx) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect' + call psb_errpush(info,name,a_err=ch_err) + end if + + if (iix /= 1) then + info=psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + end if + + err=info + call psb_errcomm(ictxt,err) + if(err /= 0) goto 9999 + + if(present(alpha)) then + if(alpha /= 1.0) then + call x%scal(alpha) + end if + end if + + liwork=nrow + if (present(work)) then + if(size(work) >= liwork) then + iwork => work + aliw=.false. + else + aliw=.true. + allocate(iwork(liwork),stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_realloc' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + end if + else + aliw=.true. + allocate(iwork(liwork),stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_realloc' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + end if + + ! exchange halo elements + if(tran_ == 'N') then + call psi_swapdata(imode,zzero,x%v,& + & desc_a,iwork,info,data=data_) + else if((tran_ == 'T').or.(tran_ == 'C')) then + call psi_swaptran(imode,zone,x%v,& + & desc_a,iwork,info) + else + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='invalid tran') + goto 9999 + end if + + if(info /= psb_success_) then + ch_err='PSI_swapdata' + call psb_errpush(psb_err_from_subroutine_,name,a_err=ch_err) + goto 9999 + end if + + if (aliw) deallocate(iwork) + nullify(iwork) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return +end subroutine psb_zhalo_vect diff --git a/base/comm/psb_zovrl.f90 b/base/comm/psb_zovrl.f90 index 381d935bc..9e9cc9cbb 100644 --- a/base/comm/psb_zovrl.f90 +++ b/base/comm/psb_zovrl.f90 @@ -164,6 +164,7 @@ subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,update,mode) else aliw=.true. end if + if (aliw) then allocate(iwork(liwork),stat=info) if(info /= psb_success_) then @@ -386,3 +387,134 @@ subroutine psb_zovrlv(x,desc_a,info,work,update,mode) end if return end subroutine psb_zovrlv + + +subroutine psb_zovrl_vect(x,desc_a,info,work,update,mode) + use psb_base_mod, psb_protect_name => psb_zovrl_vect + use psi_mod + implicit none + + type(psb_z_vect_type), intent(inout) :: x + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + complex(psb_dpk_), optional, target, intent(inout) :: work(:) + integer, intent(in), optional :: update,mode + + ! locals + integer :: ictxt, np, me, & + & err_act, m, n, iix, jjx, ix, ijx, nrow, ncol, k, update_,& + & mode_, err, liwork + complex(psb_dpk_),pointer :: iwork(:) + logical :: do_swap + character(len=20) :: name, ch_err + logical :: aliw + + name='psb_covrlv' + if(psb_get_errstatus() /= 0) return + info=psb_success_ + call psb_erractionsave(err_act) + + ictxt=desc_a%get_context() + + ! check on blacs grid + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + ix = 1 + ijx = 1 + + m = desc_a%get_global_rows() + n = desc_a%get_global_cols() + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + + k = 1 + + if (present(update)) then + update_ = update + else + update_ = psb_avg_ + endif + + if (present(mode)) then + mode_ = mode + else + mode_ = IOR(psb_swap_send_,psb_swap_recv_) + endif + do_swap = (mode_ /= 0) + + ! check vector correctness + call psb_chkvect(m,1,x%get_nrows(),ix,ijx,desc_a,info,iix,jjx) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect' + call psb_errpush(info,name,a_err=ch_err) + end if + + if (iix /= 1) then + info=psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + end if + + err=info + call psb_errcomm(ictxt,err) + if(err /= 0) goto 9999 + + ! check for presence/size of a work area + liwork=ncol + if (present(work)) then + if(size(work) >= liwork) then + aliw=.false. + else + aliw=.true. + end if + else + aliw=.true. + end if + if (aliw) then + allocate(iwork(liwork),stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='Allocate') + goto 9999 + end if + else + iwork => work + end if + + ! exchange overlap elements + if (do_swap) then + call psi_swapdata(mode_,zone,x%v,& + & desc_a,iwork,info,data=psb_comm_ovr_) + end if + if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,update_,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='Inner updates') + goto 9999 + end if + + if (aliw) deallocate(iwork) + nullify(iwork) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return +end subroutine psb_zovrl_vect + diff --git a/base/internals/psi_cswapdata.F90 b/base/internals/psi_cswapdata.F90 index cb9b0991f..03d7e3bc9 100644 --- a/base/internals/psi_cswapdata.F90 +++ b/base/internals/psi_cswapdata.F90 @@ -330,7 +330,8 @@ subroutine psi_cswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) else if (proc_to_comm == me) then if (nesd /= nerv) then - write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd + write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',& + & nerv,nesd end if rcvbuf(rcv_pt:rcv_pt+n*nerv-1) = sndbuf(snd_pt:snd_pt+n*nesd-1) end if @@ -998,3 +999,438 @@ subroutine psi_cswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i end if return end subroutine psi_cswapidxv + +subroutine psi_cswapdata_vect(flag,beta,y,desc_a,work,info,data) + + use psi_mod, psb_protect_name => psi_cswapdata_vect + use psb_c_base_vect_mod + use psb_error_mod + use psb_descriptor_type + use psb_penv_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + + integer, intent(in) :: flag + integer, intent(out) :: info + class(psb_c_base_vect_type) :: y + complex(psb_spk_) :: beta + complex(psb_spk_), target :: work(:) + type(psb_desc_type),target :: desc_a + integer, optional :: data + + ! locals + integer :: ictxt, np, me, icomm, idxs, idxr, totxch, data_, err_act + integer, pointer :: d_idx(:) + character(len=20) :: name + + info=psb_success_ + name='psi_swap_datav' + call psb_erractionsave(err_act) + + ictxt=desc_a%get_context() + call psb_info(ictxt,me,np) + if (np == -1) then + info=psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (.not.psb_is_asb_desc(desc_a)) then + info=psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + endif + + icomm = desc_a%get_mpic() + + if(present(data)) then + data_ = data + else + data_ = psb_comm_halo_ + end if + + call psb_cd_get_list(data_,desc_a,d_idx,totxch,idxr,idxs,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,a_err='psb_cd_get_list') + goto 9999 + end if + + call psi_swapdata(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) + if (info /= psb_success_) 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(ictxt) + return + end if + return +end subroutine psi_cswapdata_vect + + +subroutine psi_cswapidx_vect(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info) + + use psi_mod, psb_protect_name => psi_cswapidx_vect + use psb_error_mod + use psb_descriptor_type + use psb_penv_mod + use psb_c_base_vect_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + + integer, intent(in) :: ictxt,icomm,flag + integer, intent(out) :: info + class(psb_c_base_vect_type) :: y + complex(psb_spk_) :: beta + complex(psb_spk_), target :: work(:) + integer, intent(in) :: idx(:),totxch,totsnd, totrcv + + ! locals + integer :: np, me, nesd, nerv,& + & proc_to_comm, p2ptag, p2pstat(mpi_status_size),& + & iret, err_act, i, totsnd_, totrcv_,& + & idx_pt, snd_pt, rcv_pt, n, pnti, data_ + + integer, allocatable, dimension(:) :: bsdidx, brvidx,& + & sdsz, rvsz, prcid, rvhd, sdhd + integer :: int_err(5) + logical :: swap_mpi, swap_sync, swap_send, swap_recv,& + & albf,do_send,do_recv + logical, parameter :: usersend=.false. + + complex(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf +#ifdef HAVE_VOLATILE + volatile :: sndbuf, rcvbuf +#endif + character(len=20) :: name + + info=psb_success_ + name='psi_swap_datav' + call psb_erractionsave(err_act) + + call psb_info(ictxt,me,np) + if (np == -1) then + info=psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + n=1 + + swap_mpi = iand(flag,psb_swap_mpi_) /= 0 + swap_sync = iand(flag,psb_swap_sync_) /= 0 + swap_send = iand(flag,psb_swap_send_) /= 0 + swap_recv = iand(flag,psb_swap_recv_) /= 0 + do_send = swap_mpi .or. swap_sync .or. swap_send + do_recv = swap_mpi .or. swap_sync .or. swap_recv + + totrcv_ = totrcv * n + totsnd_ = totsnd * n + + if (swap_mpi) then + allocate(sdsz(0:np-1), rvsz(0:np-1), bsdidx(0:np-1),& + & brvidx(0:np-1), rvhd(0:np-1), sdhd(0:np-1), prcid(0:np-1),& + & stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + + rvhd(:) = mpi_request_null + sdsz(:) = 0 + rvsz(:) = 0 + + ! prepare info for communications + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + call psb_get_rank(prcid(proc_to_comm),ictxt,proc_to_comm) + + brvidx(proc_to_comm) = rcv_pt + rvsz(proc_to_comm) = nerv + + bsdidx(proc_to_comm) = snd_pt + sdsz(proc_to_comm) = nesd + + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + + end do + + else + allocate(rvhd(totxch),prcid(totxch),stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + end if + + + totrcv_ = max(totrcv_,1) + totsnd_ = max(totsnd_,1) + if((totrcv_+totsnd_) < size(work)) then + sndbuf => work(1:totsnd_) + rcvbuf => work(totsnd_+1:totsnd_+totrcv_) + albf=.false. + else + allocate(sndbuf(totsnd_),rcvbuf(totrcv_), stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + albf=.true. + end if + + + if (do_send) then + + ! Pack send buffers + pnti = 1 + snd_pt = 1 + do i=1, totxch + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + idx_pt = 1+pnti+nerv+psb_n_elem_send_ + call y%gth(nesd,idx(idx_pt:idx_pt+nesd-1),& + & sndbuf(snd_pt:snd_pt+nesd-1)) + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + end if + + ! Case SWAP_MPI + if (swap_mpi) then + + ! swap elements using mpi_alltoallv + call mpi_alltoallv(sndbuf,sdsz,bsdidx,& + & mpi_complex,rcvbuf,rvsz,& + & brvidx,mpi_complex,icomm,iret) + if(iret /= mpi_success) then + int_err(1) = iret + info=psb_err_mpi_error_ + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + else if (swap_sync) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + + if (proc_to_comm < me) then + if (nesd>0) call psb_snd(ictxt,& + & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) + if (nerv>0) call psb_rcv(ictxt,& + & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) + else if (proc_to_comm > me) then + if (nerv>0) call psb_rcv(ictxt,& + & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) + if (nesd>0) call psb_snd(ictxt,& + & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) + else if (proc_to_comm == me) then + if (nesd /= nerv) then + write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',& + & nerv,nesd + end if + rcvbuf(rcv_pt:rcv_pt+nerv-1) = sndbuf(snd_pt:snd_pt+nesd-1) + end if + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + + else if (swap_send .and. swap_recv) then + + ! First I post all the non blocking receives + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + + call psb_get_rank(prcid(i),ictxt,proc_to_comm) + if ((nerv>0).and.(proc_to_comm /= me)) then + p2ptag = psb_complex_swap_tag + call mpi_irecv(rcvbuf(rcv_pt),nerv,& + & mpi_complex,prcid(i),& + & p2ptag, icomm,rvhd(i),iret) + end if + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + + ! Then I post all the blocking sends + if (usersend) call mpi_barrier(icomm,info) + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + + p2ptag=psb_complex_swap_tag + + if ((nesd>0).and.(proc_to_comm /= me)) then + if (usersend) then + call mpi_rsend(sndbuf(snd_pt),nesd,& + & mpi_complex,prcid(i),& + & p2ptag,icomm,iret) + else + call mpi_send(sndbuf(snd_pt),nesd,& + & mpi_complex,prcid(i),& + & p2ptag,icomm,iret) + end if + + if(iret /= mpi_success) then + int_err(1) = iret + info=psb_err_mpi_error_ + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + end if + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + + pnti = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + + p2ptag =psb_complex_swap_tag + + if ((proc_to_comm /= me).and.(nerv>0)) then + call mpi_wait(rvhd(i),p2pstat,iret) + if(iret /= mpi_success) then + int_err(1) = iret + info=psb_err_mpi_error_ + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + else if (proc_to_comm == me) then + if (nesd /= nerv) then + write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',& + & nerv,nesd + end if + rcvbuf(rcv_pt:rcv_pt+nerv-1) = sndbuf(snd_pt:snd_pt+nesd-1) + end if + pnti = pnti + nerv + nesd + 3 + end do + + + else if (swap_send) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + if (nesd>0) call psb_snd(ictxt,& + & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + else if (swap_recv) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + if (nerv>0) call psb_rcv(ictxt,& + & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + end if + + if (do_recv) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + idx_pt = 1+pnti+psb_n_elem_recv_ + call y%sct(nerv,idx(idx_pt:idx_pt+nerv-1),& + & rcvbuf(rcv_pt:rcv_pt+nerv-1),beta) + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + end if + + if (swap_mpi) then + deallocate(sdsz,rvsz,bsdidx,brvidx,rvhd,prcid,sdhd,& + & stat=info) + else + deallocate(rvhd,prcid,stat=info) + end if + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + if(albf) deallocate(sndbuf,rcvbuf,stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,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(ictxt) + return + end if + return +end subroutine psi_cswapidx_vect + diff --git a/base/internals/psi_cswaptran.F90 b/base/internals/psi_cswaptran.F90 index f476d8087..66f06a0bd 100644 --- a/base/internals/psi_cswaptran.F90 +++ b/base/internals/psi_cswaptran.F90 @@ -309,8 +309,8 @@ subroutine psi_ctranidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work ! swap elements using mpi_alltoallv call mpi_alltoallv(rcvbuf,rvsz,brvidx,& - & mpi_double_precision,& - & sndbuf,sdsz,bsdidx,mpi_double_precision,icomm,iret) + & mpi_complex,& + & sndbuf,sdsz,bsdidx,mpi_complex,icomm,iret) if(iret /= mpi_success) then int_err(1) = iret info=psb_err_mpi_error_ @@ -798,8 +798,8 @@ subroutine psi_ctranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i ! swap elements using mpi_alltoallv call mpi_alltoallv(rcvbuf,rvsz,brvidx,& - & mpi_double_precision,& - & sndbuf,sdsz,bsdidx,mpi_double_precision,icomm,iret) + & mpi_complex,& + & sndbuf,sdsz,bsdidx,mpi_complex,icomm,iret) if(iret /= mpi_success) then int_err(1) = iret info=psb_err_mpi_error_ @@ -1009,3 +1009,448 @@ subroutine psi_ctranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i end if return end subroutine psi_ctranidxv + + +subroutine psi_cswaptran_vect(flag,beta,y,desc_a,work,info,data) + + use psi_mod, psb_protect_name => psi_cswaptran_vect + use psb_error_mod + use psb_descriptor_type + use psb_penv_mod + use psb_c_base_vect_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + + integer, intent(in) :: flag + integer, intent(out) :: info + class(psb_c_base_vect_type) :: y + complex(psb_spk_) :: beta + complex(psb_spk_), target :: work(:) + type(psb_desc_type),target :: desc_a + integer, optional :: data + + ! locals + integer :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ + integer, pointer :: d_idx(:) + integer :: int_err(5) + character(len=20) :: name + + info=psb_success_ + name='psi_swap_tranv' + call psb_erractionsave(err_act) + + ictxt = desc_a%get_context() + icomm = desc_a%get_mpic() + call psb_info(ictxt,me,np) + if (np == -1) then + info=psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (.not.psb_is_asb_desc(desc_a)) then + info=psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + endif + + if (present(data)) then + data_ = data + else + data_ = psb_comm_halo_ + end if + + call psb_cd_get_list(data_,desc_a,d_idx,totxch,idxr,idxs,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,a_err='psb_cd_get_list') + goto 9999 + end if + + call psi_swaptran(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) + if (info /= psb_success_) 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(ictxt) + return + end if + return +end subroutine psi_cswaptran_vect + + + +subroutine psi_ctranidx_vect(ictxt,icomm,flag,beta,y,idx,& + & totxch,totsnd,totrcv,work,info) + + use psi_mod, psb_protect_name => psi_ctranidx_vect + use psb_error_mod + use psb_descriptor_type + use psb_penv_mod + use psb_c_base_vect_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + + integer, intent(in) :: ictxt,icomm,flag + integer, intent(out) :: info + class(psb_c_base_vect_type) :: y + complex(psb_spk_) :: beta + complex(psb_spk_), target :: work(:) + integer, intent(in) :: idx(:),totxch,totsnd, totrcv + + ! locals + integer :: np, me, nesd, nerv,& + & proc_to_comm, p2ptag, p2pstat(mpi_status_size),& + & iret, err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti, data_, n + integer, allocatable, dimension(:) :: bsdidx, brvidx,& + & sdsz, rvsz, prcid, rvhd, sdhd + integer :: int_err(5) + logical :: swap_mpi, swap_sync, swap_send, swap_recv,& + & albf,do_send,do_recv + logical, parameter :: usersend=.false. + + complex(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf +#ifdef HAVE_VOLATILE + volatile :: sndbuf, rcvbuf +#endif + character(len=20) :: name + + info=psb_success_ + name='psi_swap_tran' + call psb_erractionsave(err_act) + + call psb_info(ictxt,me,np) + if (np == -1) then + info=psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + n=1 + swap_mpi = iand(flag,psb_swap_mpi_) /= 0 + swap_sync = iand(flag,psb_swap_sync_) /= 0 + swap_send = iand(flag,psb_swap_send_) /= 0 + swap_recv = iand(flag,psb_swap_recv_) /= 0 + do_send = swap_mpi .or. swap_sync .or. swap_send + do_recv = swap_mpi .or. swap_sync .or. swap_recv + + totrcv_ = totrcv * n + totsnd_ = totsnd * n + + if (swap_mpi) then + allocate(sdsz(0:np-1), rvsz(0:np-1), bsdidx(0:np-1),& + & brvidx(0:np-1), rvhd(0:np-1), sdhd(0:np-1), prcid(0:np-1),& + & stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + + rvhd(:) = mpi_request_null + sdsz(:) = 0 + rvsz(:) = 0 + + ! prepare info for communications + + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + call psb_get_rank(prcid(proc_to_comm),ictxt,proc_to_comm) + + brvidx(proc_to_comm) = rcv_pt + rvsz(proc_to_comm) = nerv + + bsdidx(proc_to_comm) = snd_pt + sdsz(proc_to_comm) = nesd + + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + + end do + + else + allocate(rvhd(totxch),prcid(totxch),stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + end if + + + totrcv_ = max(totrcv_,1) + totsnd_ = max(totsnd_,1) + if((totrcv_+totsnd_) < size(work)) then + sndbuf => work(1:totsnd_) + rcvbuf => work(totsnd_+1:totsnd_+totrcv_) + albf=.false. + else + allocate(sndbuf(totsnd_),rcvbuf(totrcv_), stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + albf=.true. + end if + + + if (do_send) then + + ! Pack send buffers + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + idx_pt = 1+pnti+psb_n_elem_recv_ + + call y%gth(nerv,idx(idx_pt:idx_pt+nerv-1),& + & rcvbuf(rcv_pt:rcv_pt+nerv-1)) + + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + end if + + ! Case SWAP_MPI + if (swap_mpi) then + + ! swap elements using mpi_alltoallv + call mpi_alltoallv(rcvbuf,rvsz,brvidx,& + & mpi_complex,& + & sndbuf,sdsz,bsdidx,mpi_complex,icomm,iret) + if(iret /= mpi_success) then + int_err(1) = iret + info=psb_err_mpi_error_ + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + else if (swap_sync) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + + if (proc_to_comm < me) then + if (nerv>0) call psb_snd(ictxt,& + & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) + if (nesd>0) call psb_rcv(ictxt,& + & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) + else if (proc_to_comm > me) then + if (nesd>0) call psb_rcv(ictxt,& + & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) + if (nerv>0) call psb_snd(ictxt,& + & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) + else if (proc_to_comm == me) then + if (nesd /= nerv) then + write(psb_err_unit,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd + end if + sndbuf(snd_pt:snd_pt+nesd-1) = rcvbuf(rcv_pt:rcv_pt+nerv-1) + end if + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + + end do + + + else if (swap_send .and. swap_recv) then + + ! First I post all the non blocking receives + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + call psb_get_rank(prcid(i),ictxt,proc_to_comm) + if ((nesd>0).and.(proc_to_comm /= me)) then + p2ptag = psb_complex_swap_tag + call mpi_irecv(sndbuf(snd_pt),nesd,& + & mpi_complex,prcid(i),& + & p2ptag,icomm,rvhd(i),iret) + end if + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + + ! Then I post all the blocking sends + if (usersend) call mpi_barrier(icomm,info) + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + + if ((nerv>0).and.(proc_to_comm /= me)) then + p2ptag=psb_complex_swap_tag + if (usersend) then + call mpi_rsend(rcvbuf(rcv_pt),nerv,& + & mpi_complex,prcid(i),& + & p2ptag, icomm,iret) + else + call mpi_send(rcvbuf(rcv_pt),nerv,& + & mpi_complex,prcid(i),& + & p2ptag, icomm,iret) + end if + + if(iret /= mpi_success) then + int_err(1) = iret + info=psb_err_mpi_error_ + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + end if + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + + end do + + + pnti = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + p2ptag = psb_complex_swap_tag + + if ((proc_to_comm /= me).and.(nesd>0)) then + call mpi_wait(rvhd(i),p2pstat,iret) + if(iret /= mpi_success) then + int_err(1) = iret + info=psb_err_mpi_error_ + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + else if (proc_to_comm == me) then + if (nesd /= nerv) then + write(psb_err_unit,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd + end if + sndbuf(snd_pt:snd_pt+nesd-1) = rcvbuf(rcv_pt:rcv_pt+nerv-1) + end if + pnti = pnti + nerv + nesd + 3 + end do + + + else if (swap_send) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + if (nerv>0) call psb_snd(ictxt,& + & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + + end do + + else if (swap_recv) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + if (nesd>0) call psb_rcv(ictxt,& + & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + + end do + + end if + + + if (do_recv) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + idx_pt = 1+pnti+nerv+psb_n_elem_send_ + call y%sct(nesd,idx(idx_pt:idx_pt+nesd-1),& + & sndbuf(snd_pt:snd_pt+nesd-1),beta) + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + end if + + + if (swap_mpi) then + deallocate(sdsz,rvsz,bsdidx,brvidx,rvhd,prcid,sdhd,& + & stat=info) + else + deallocate(rvhd,prcid,stat=info) + end if + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + if(albf) deallocate(sndbuf,rcvbuf,stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,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(ictxt) + return + end if + return +end subroutine psi_ctranidx_vect + + + diff --git a/base/internals/psi_dswapdata.F90 b/base/internals/psi_dswapdata.F90 index eef9e02b3..099316d8e 100644 --- a/base/internals/psi_dswapdata.F90 +++ b/base/internals/psi_dswapdata.F90 @@ -331,7 +331,8 @@ subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) else if (proc_to_comm == me) then if (nesd /= nerv) then - write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd + write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',& + & nerv,nesd end if rcvbuf(rcv_pt:rcv_pt+n*nerv-1) = sndbuf(snd_pt:snd_pt+n*nesd-1) end if @@ -424,7 +425,8 @@ subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work end if else if (proc_to_comm == me) then if (nesd /= nerv) then - write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd + write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',& + & nerv,nesd end if rcvbuf(rcv_pt:rcv_pt+n*nerv-1) = sndbuf(snd_pt:snd_pt+n*nesd-1) end if @@ -821,7 +823,8 @@ subroutine psi_dswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) else if (proc_to_comm == me) then if (nesd /= nerv) then - write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd + write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',& + & nerv,nesd end if rcvbuf(rcv_pt:rcv_pt+nerv-1) = sndbuf(snd_pt:snd_pt+nesd-1) end if @@ -910,7 +913,8 @@ subroutine psi_dswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i end if else if (proc_to_comm == me) then if (nesd /= nerv) then - write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd + write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',& + & nerv,nesd end if rcvbuf(rcv_pt:rcv_pt+nerv-1) = sndbuf(snd_pt:snd_pt+nesd-1) end if @@ -998,3 +1002,440 @@ subroutine psi_dswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i end if return end subroutine psi_dswapidxv + + + +subroutine psi_dswapdata_vect(flag,beta,y,desc_a,work,info,data) + + use psi_mod, psb_protect_name => psi_dswapdata_vect + use psb_d_base_vect_mod + use psb_error_mod + use psb_descriptor_type + use psb_penv_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + + integer, intent(in) :: flag + integer, intent(out) :: info + class(psb_d_base_vect_type) :: y + real(psb_dpk_) :: beta + real(psb_dpk_), target :: work(:) + type(psb_desc_type),target :: desc_a + integer, optional :: data + + ! locals + integer :: ictxt, np, me, icomm, idxs, idxr, totxch, data_, err_act + integer, pointer :: d_idx(:) + character(len=20) :: name + + info=psb_success_ + name='psi_swap_datav' + call psb_erractionsave(err_act) + + ictxt=desc_a%get_context() + call psb_info(ictxt,me,np) + if (np == -1) then + info=psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (.not.psb_is_asb_desc(desc_a)) then + info=psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + endif + + icomm = desc_a%get_mpic() + + if(present(data)) then + data_ = data + else + data_ = psb_comm_halo_ + end if + + call psb_cd_get_list(data_,desc_a,d_idx,totxch,idxr,idxs,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,a_err='psb_cd_get_list') + goto 9999 + end if + + call psi_swapdata(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) + if (info /= psb_success_) 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(ictxt) + return + end if + return +end subroutine psi_dswapdata_vect + + +subroutine psi_dswapidx_vect(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info) + + use psi_mod, psb_protect_name => psi_dswapidx_vect + use psb_error_mod + use psb_descriptor_type + use psb_penv_mod + use psb_d_base_vect_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + + integer, intent(in) :: ictxt,icomm,flag + integer, intent(out) :: info + class(psb_d_base_vect_type) :: y + real(psb_dpk_) :: beta + real(psb_dpk_), target :: work(:) + integer, intent(in) :: idx(:),totxch,totsnd, totrcv + + ! locals + integer :: np, me, nesd, nerv,& + & proc_to_comm, p2ptag, p2pstat(mpi_status_size),& + & iret, err_act, i, totsnd_, totrcv_,& + & idx_pt, snd_pt, rcv_pt, n, pnti, data_ + + integer, allocatable, dimension(:) :: bsdidx, brvidx,& + & sdsz, rvsz, prcid, rvhd, sdhd + integer :: int_err(5) + logical :: swap_mpi, swap_sync, swap_send, swap_recv,& + & albf,do_send,do_recv + logical, parameter :: usersend=.false. + + real(psb_dpk_), pointer, dimension(:) :: sndbuf, rcvbuf +#ifdef HAVE_VOLATILE + volatile :: sndbuf, rcvbuf +#endif + character(len=20) :: name + + info=psb_success_ + name='psi_swap_datav' + call psb_erractionsave(err_act) + + call psb_info(ictxt,me,np) + if (np == -1) then + info=psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + n=1 + + swap_mpi = iand(flag,psb_swap_mpi_) /= 0 + swap_sync = iand(flag,psb_swap_sync_) /= 0 + swap_send = iand(flag,psb_swap_send_) /= 0 + swap_recv = iand(flag,psb_swap_recv_) /= 0 + do_send = swap_mpi .or. swap_sync .or. swap_send + do_recv = swap_mpi .or. swap_sync .or. swap_recv + + totrcv_ = totrcv * n + totsnd_ = totsnd * n + + if (swap_mpi) then + allocate(sdsz(0:np-1), rvsz(0:np-1), bsdidx(0:np-1),& + & brvidx(0:np-1), rvhd(0:np-1), sdhd(0:np-1), prcid(0:np-1),& + & stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + + rvhd(:) = mpi_request_null + sdsz(:) = 0 + rvsz(:) = 0 + + ! prepare info for communications + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + call psb_get_rank(prcid(proc_to_comm),ictxt,proc_to_comm) + + brvidx(proc_to_comm) = rcv_pt + rvsz(proc_to_comm) = nerv + + bsdidx(proc_to_comm) = snd_pt + sdsz(proc_to_comm) = nesd + + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + + end do + + else + allocate(rvhd(totxch),prcid(totxch),stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + end if + + + totrcv_ = max(totrcv_,1) + totsnd_ = max(totsnd_,1) + if((totrcv_+totsnd_) < size(work)) then + sndbuf => work(1:totsnd_) + rcvbuf => work(totsnd_+1:totsnd_+totrcv_) + albf=.false. + else + allocate(sndbuf(totsnd_),rcvbuf(totrcv_), stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + albf=.true. + end if + + + if (do_send) then + + ! Pack send buffers + pnti = 1 + snd_pt = 1 + do i=1, totxch + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + idx_pt = 1+pnti+nerv+psb_n_elem_send_ + call y%gth(nesd,idx(idx_pt:idx_pt+nesd-1),& + & sndbuf(snd_pt:snd_pt+nesd-1)) + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + end if + + ! Case SWAP_MPI + if (swap_mpi) then + + ! swap elements using mpi_alltoallv + call mpi_alltoallv(sndbuf,sdsz,bsdidx,& + & mpi_double_precision,rcvbuf,rvsz,& + & brvidx,mpi_double_precision,icomm,iret) + if(iret /= mpi_success) then + int_err(1) = iret + info=psb_err_mpi_error_ + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + else if (swap_sync) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + + if (proc_to_comm < me) then + if (nesd>0) call psb_snd(ictxt,& + & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) + if (nerv>0) call psb_rcv(ictxt,& + & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) + else if (proc_to_comm > me) then + if (nerv>0) call psb_rcv(ictxt,& + & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) + if (nesd>0) call psb_snd(ictxt,& + & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) + else if (proc_to_comm == me) then + if (nesd /= nerv) then + write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',& + & nerv,nesd + end if + rcvbuf(rcv_pt:rcv_pt+nerv-1) = sndbuf(snd_pt:snd_pt+nesd-1) + end if + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + + else if (swap_send .and. swap_recv) then + + ! First I post all the non blocking receives + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + + call psb_get_rank(prcid(i),ictxt,proc_to_comm) + if ((nerv>0).and.(proc_to_comm /= me)) then + p2ptag = psb_double_swap_tag + call mpi_irecv(rcvbuf(rcv_pt),nerv,& + & mpi_double_precision,prcid(i),& + & p2ptag, icomm,rvhd(i),iret) + end if + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + + ! Then I post all the blocking sends + if (usersend) call mpi_barrier(icomm,info) + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + + p2ptag=psb_double_swap_tag + + if ((nesd>0).and.(proc_to_comm /= me)) then + if (usersend) then + call mpi_rsend(sndbuf(snd_pt),nesd,& + & mpi_double_precision,prcid(i),& + & p2ptag,icomm,iret) + else + call mpi_send(sndbuf(snd_pt),nesd,& + & mpi_double_precision,prcid(i),& + & p2ptag,icomm,iret) + end if + + if(iret /= mpi_success) then + int_err(1) = iret + info=psb_err_mpi_error_ + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + end if + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + + pnti = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + + p2ptag =psb_double_swap_tag + + if ((proc_to_comm /= me).and.(nerv>0)) then + call mpi_wait(rvhd(i),p2pstat,iret) + if(iret /= mpi_success) then + int_err(1) = iret + info=psb_err_mpi_error_ + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + else if (proc_to_comm == me) then + if (nesd /= nerv) then + write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',& + & nerv,nesd + end if + rcvbuf(rcv_pt:rcv_pt+nerv-1) = sndbuf(snd_pt:snd_pt+nesd-1) + end if + pnti = pnti + nerv + nesd + 3 + end do + + + else if (swap_send) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + if (nesd>0) call psb_snd(ictxt,& + & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + else if (swap_recv) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + if (nerv>0) call psb_rcv(ictxt,& + & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + end if + + if (do_recv) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + idx_pt = 1+pnti+psb_n_elem_recv_ + call y%sct(nerv,idx(idx_pt:idx_pt+nerv-1),& + & rcvbuf(rcv_pt:rcv_pt+nerv-1),beta) + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + end if + + if (swap_mpi) then + deallocate(sdsz,rvsz,bsdidx,brvidx,rvhd,prcid,sdhd,& + & stat=info) + else + deallocate(rvhd,prcid,stat=info) + end if + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + if(albf) deallocate(sndbuf,rcvbuf,stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,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(ictxt) + return + end if + return +end subroutine psi_dswapidx_vect + diff --git a/base/internals/psi_dswaptran.F90 b/base/internals/psi_dswaptran.F90 index 46bb54c68..b834f9e43 100644 --- a/base/internals/psi_dswaptran.F90 +++ b/base/internals/psi_dswaptran.F90 @@ -682,6 +682,9 @@ subroutine psi_dtranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i logical, parameter :: usersend=.false. real(psb_dpk_), pointer, dimension(:) :: sndbuf, rcvbuf +#ifdef HAVE_VOLATILE + volatile :: sndbuf, rcvbuf +#endif character(len=20) :: name info=psb_success_ @@ -1006,3 +1009,447 @@ subroutine psi_dtranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i end if return end subroutine psi_dtranidxv + +subroutine psi_dswaptran_vect(flag,beta,y,desc_a,work,info,data) + + use psi_mod, psb_protect_name => psi_dswaptran_vect + use psb_error_mod + use psb_descriptor_type + use psb_penv_mod + use psb_d_base_vect_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + + integer, intent(in) :: flag + integer, intent(out) :: info + class(psb_d_base_vect_type) :: y + real(psb_dpk_) :: beta + real(psb_dpk_), target :: work(:) + type(psb_desc_type),target :: desc_a + integer, optional :: data + + ! locals + integer :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ + integer, pointer :: d_idx(:) + integer :: int_err(5) + character(len=20) :: name + + info=psb_success_ + name='psi_swap_tranv' + call psb_erractionsave(err_act) + + ictxt = desc_a%get_context() + icomm = desc_a%get_mpic() + call psb_info(ictxt,me,np) + if (np == -1) then + info=psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (.not.psb_is_asb_desc(desc_a)) then + info=psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + endif + + if (present(data)) then + data_ = data + else + data_ = psb_comm_halo_ + end if + + call psb_cd_get_list(data_,desc_a,d_idx,totxch,idxr,idxs,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,a_err='psb_cd_get_list') + goto 9999 + end if + + call psi_swaptran(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) + if (info /= psb_success_) 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(ictxt) + return + end if + return +end subroutine psi_dswaptran_vect + + + +subroutine psi_dtranidx_vect(ictxt,icomm,flag,beta,y,idx,& + & totxch,totsnd,totrcv,work,info) + + use psi_mod, psb_protect_name => psi_dtranidx_vect + use psb_error_mod + use psb_descriptor_type + use psb_penv_mod + use psb_d_base_vect_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + + integer, intent(in) :: ictxt,icomm,flag + integer, intent(out) :: info + class(psb_d_base_vect_type) :: y + real(psb_dpk_) :: beta + real(psb_dpk_), target :: work(:) + integer, intent(in) :: idx(:),totxch,totsnd, totrcv + + ! locals + integer :: np, me, nesd, nerv,& + & proc_to_comm, p2ptag, p2pstat(mpi_status_size),& + & iret, err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti, data_, n + integer, allocatable, dimension(:) :: bsdidx, brvidx,& + & sdsz, rvsz, prcid, rvhd, sdhd + integer :: int_err(5) + logical :: swap_mpi, swap_sync, swap_send, swap_recv,& + & albf,do_send,do_recv + logical, parameter :: usersend=.false. + + real(psb_dpk_), pointer, dimension(:) :: sndbuf, rcvbuf +#ifdef HAVE_VOLATILE + volatile :: sndbuf, rcvbuf +#endif + character(len=20) :: name + + info=psb_success_ + name='psi_swap_tran' + call psb_erractionsave(err_act) + + call psb_info(ictxt,me,np) + if (np == -1) then + info=psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + n=1 + swap_mpi = iand(flag,psb_swap_mpi_) /= 0 + swap_sync = iand(flag,psb_swap_sync_) /= 0 + swap_send = iand(flag,psb_swap_send_) /= 0 + swap_recv = iand(flag,psb_swap_recv_) /= 0 + do_send = swap_mpi .or. swap_sync .or. swap_send + do_recv = swap_mpi .or. swap_sync .or. swap_recv + + totrcv_ = totrcv * n + totsnd_ = totsnd * n + + if (swap_mpi) then + allocate(sdsz(0:np-1), rvsz(0:np-1), bsdidx(0:np-1),& + & brvidx(0:np-1), rvhd(0:np-1), sdhd(0:np-1), prcid(0:np-1),& + & stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + + rvhd(:) = mpi_request_null + sdsz(:) = 0 + rvsz(:) = 0 + + ! prepare info for communications + + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + call psb_get_rank(prcid(proc_to_comm),ictxt,proc_to_comm) + + brvidx(proc_to_comm) = rcv_pt + rvsz(proc_to_comm) = nerv + + bsdidx(proc_to_comm) = snd_pt + sdsz(proc_to_comm) = nesd + + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + + end do + + else + allocate(rvhd(totxch),prcid(totxch),stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + end if + + + totrcv_ = max(totrcv_,1) + totsnd_ = max(totsnd_,1) + if((totrcv_+totsnd_) < size(work)) then + sndbuf => work(1:totsnd_) + rcvbuf => work(totsnd_+1:totsnd_+totrcv_) + albf=.false. + else + allocate(sndbuf(totsnd_),rcvbuf(totrcv_), stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + albf=.true. + end if + + + if (do_send) then + + ! Pack send buffers + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + idx_pt = 1+pnti+psb_n_elem_recv_ + + call y%gth(nerv,idx(idx_pt:idx_pt+nerv-1),& + & rcvbuf(rcv_pt:rcv_pt+nerv-1)) + + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + end if + + ! Case SWAP_MPI + if (swap_mpi) then + + ! swap elements using mpi_alltoallv + call mpi_alltoallv(rcvbuf,rvsz,brvidx,& + & mpi_double_precision,& + & sndbuf,sdsz,bsdidx,mpi_double_precision,icomm,iret) + if(iret /= mpi_success) then + int_err(1) = iret + info=psb_err_mpi_error_ + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + else if (swap_sync) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + + if (proc_to_comm < me) then + if (nerv>0) call psb_snd(ictxt,& + & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) + if (nesd>0) call psb_rcv(ictxt,& + & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) + else if (proc_to_comm > me) then + if (nesd>0) call psb_rcv(ictxt,& + & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) + if (nerv>0) call psb_snd(ictxt,& + & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) + else if (proc_to_comm == me) then + if (nesd /= nerv) then + write(psb_err_unit,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd + end if + sndbuf(snd_pt:snd_pt+nesd-1) = rcvbuf(rcv_pt:rcv_pt+nerv-1) + end if + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + + end do + + + else if (swap_send .and. swap_recv) then + + ! First I post all the non blocking receives + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + call psb_get_rank(prcid(i),ictxt,proc_to_comm) + if ((nesd>0).and.(proc_to_comm /= me)) then + p2ptag = psb_double_swap_tag + call mpi_irecv(sndbuf(snd_pt),nesd,& + & mpi_double_precision,prcid(i),& + & p2ptag,icomm,rvhd(i),iret) + end if + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + + ! Then I post all the blocking sends + if (usersend) call mpi_barrier(icomm,info) + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + + if ((nerv>0).and.(proc_to_comm /= me)) then + p2ptag=psb_double_swap_tag + if (usersend) then + call mpi_rsend(rcvbuf(rcv_pt),nerv,& + & mpi_double_precision,prcid(i),& + & p2ptag, icomm,iret) + else + call mpi_send(rcvbuf(rcv_pt),nerv,& + & mpi_double_precision,prcid(i),& + & p2ptag, icomm,iret) + end if + + if(iret /= mpi_success) then + int_err(1) = iret + info=psb_err_mpi_error_ + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + end if + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + + end do + + + pnti = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + p2ptag = psb_double_swap_tag + + if ((proc_to_comm /= me).and.(nesd>0)) then + call mpi_wait(rvhd(i),p2pstat,iret) + if(iret /= mpi_success) then + int_err(1) = iret + info=psb_err_mpi_error_ + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + else if (proc_to_comm == me) then + if (nesd /= nerv) then + write(psb_err_unit,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd + end if + sndbuf(snd_pt:snd_pt+nesd-1) = rcvbuf(rcv_pt:rcv_pt+nerv-1) + end if + pnti = pnti + nerv + nesd + 3 + end do + + + else if (swap_send) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + if (nerv>0) call psb_snd(ictxt,& + & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + + end do + + else if (swap_recv) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + if (nesd>0) call psb_rcv(ictxt,& + & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + + end do + + end if + + + if (do_recv) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + idx_pt = 1+pnti+nerv+psb_n_elem_send_ + call y%sct(nesd,idx(idx_pt:idx_pt+nesd-1),& + & sndbuf(snd_pt:snd_pt+nesd-1),beta) + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + end if + + + if (swap_mpi) then + deallocate(sdsz,rvsz,bsdidx,brvidx,rvhd,prcid,sdhd,& + & stat=info) + else + deallocate(rvhd,prcid,stat=info) + end if + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + if(albf) deallocate(sndbuf,rcvbuf,stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,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(ictxt) + return + end if + return +end subroutine psi_dtranidx_vect + + + diff --git a/base/internals/psi_idx_ins_cnv.f90 b/base/internals/psi_idx_ins_cnv.f90 index 7c1090371..c2a2c4ce6 100644 --- a/base/internals/psi_idx_ins_cnv.f90 +++ b/base/internals/psi_idx_ins_cnv.f90 @@ -191,7 +191,6 @@ subroutine psi_idx_ins_cnv2(nv,idxin,idxout,desc,info,mask) use psb_const_mod use psb_error_mod use psb_penv_mod - use psi_mod implicit none integer, intent(in) :: nv, idxin(:) integer, intent(out) :: idxout(:) diff --git a/base/internals/psi_ovrl_restr.f90 b/base/internals/psi_ovrl_restr.f90 index 27e8ea1d1..a351321c9 100644 --- a/base/internals/psi_ovrl_restr.f90 +++ b/base/internals/psi_ovrl_restr.f90 @@ -528,3 +528,188 @@ subroutine psi_iovrl_restrr2(x,xs,desc_a,info) end if return end subroutine psi_iovrl_restrr2 + + + +subroutine psi_sovrl_restr_vect(x,xs,desc_a,info) + use psi_mod, psi_protect_name => psi_sovrl_restr_vect + use psb_s_base_vect_mod + + implicit none + + class(psb_s_base_vect_type) :: x + real(psb_spk_) :: xs(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + + ! locals + integer :: ictxt, np, me, err_act, i, idx, isz + character(len=20) :: name, ch_err + + name='psi_sovrl_restrr1' + if (psb_get_errstatus() /= 0) return + info = psb_success_ + call psb_erractionsave(err_act) + ictxt = desc_a%get_context() + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + isz = size(desc_a%ovrlap_elem,1) + + call x%sct(isz,desc_a%ovrlap_elem(:,1),xs,szero) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return +end subroutine psi_sovrl_restr_vect + + +subroutine psi_dovrl_restr_vect(x,xs,desc_a,info) + use psi_mod, psi_protect_name => psi_dovrl_restr_vect + use psb_d_base_vect_mod + + implicit none + + class(psb_d_base_vect_type) :: x + real(psb_dpk_) :: xs(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + + ! locals + integer :: ictxt, np, me, err_act, i, idx, isz + character(len=20) :: name, ch_err + + name='psi_dovrl_restrr1' + if (psb_get_errstatus() /= 0) return + info = psb_success_ + call psb_erractionsave(err_act) + ictxt = desc_a%get_context() + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + isz = size(desc_a%ovrlap_elem,1) + + call x%sct(isz,desc_a%ovrlap_elem(:,1),xs,dzero) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return +end subroutine psi_dovrl_restr_vect + + + + +subroutine psi_covrl_restr_vect(x,xs,desc_a,info) + use psi_mod, psi_protect_name => psi_covrl_restr_vect + use psb_c_base_vect_mod + + implicit none + + class(psb_c_base_vect_type) :: x + complex(psb_spk_) :: xs(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + + ! locals + integer :: ictxt, np, me, err_act, i, idx, isz + character(len=20) :: name, ch_err + + name='psi_covrl_restrr1' + if (psb_get_errstatus() /= 0) return + info = psb_success_ + call psb_erractionsave(err_act) + ictxt = desc_a%get_context() + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + isz = size(desc_a%ovrlap_elem,1) + + call x%sct(isz,desc_a%ovrlap_elem(:,1),xs,czero) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return +end subroutine psi_covrl_restr_vect + + +subroutine psi_zovrl_restr_vect(x,xs,desc_a,info) + use psi_mod, psi_protect_name => psi_zovrl_restr_vect + use psb_z_base_vect_mod + + implicit none + + class(psb_z_base_vect_type) :: x + complex(psb_dpk_) :: xs(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + + ! locals + integer :: ictxt, np, me, err_act, i, idx, isz + character(len=20) :: name, ch_err + + name='psi_zovrl_restrr1' + if (psb_get_errstatus() /= 0) return + info = psb_success_ + call psb_erractionsave(err_act) + ictxt = desc_a%get_context() + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + isz = size(desc_a%ovrlap_elem,1) + + call x%sct(isz,desc_a%ovrlap_elem(:,1),xs,zzero) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return +end subroutine psi_zovrl_restr_vect + + diff --git a/base/internals/psi_ovrl_save.f90 b/base/internals/psi_ovrl_save.f90 index c406550ed..debfb26d2 100644 --- a/base/internals/psi_ovrl_save.f90 +++ b/base/internals/psi_ovrl_save.f90 @@ -577,3 +577,208 @@ subroutine psi_iovrl_saver2(x,xs,desc_a,info) return end subroutine psi_iovrl_saver2 + + +subroutine psi_sovrl_save_vect(x,xs,desc_a,info) + use psi_mod, psi_protect_name => psi_sovrl_save_vect + use psb_realloc_mod + use psb_s_base_vect_mod + + implicit none + + class(psb_s_base_vect_type) :: x + real(psb_spk_), allocatable :: xs(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + + ! locals + integer :: ictxt, np, me, err_act, i, idx, isz + character(len=20) :: name, ch_err + + name='psi_sovrl_saver1' + if (psb_get_errstatus() /= 0) return + info = psb_success_ + call psb_erractionsave(err_act) + ictxt = desc_a%get_context() + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + isz = size(desc_a%ovrlap_elem,1) + call psb_realloc(isz,xs,info) + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + endif + + call x%gth(isz,desc_a%ovrlap_elem(:,1),xs) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return +end subroutine psi_sovrl_save_vect + +subroutine psi_dovrl_save_vect(x,xs,desc_a,info) + use psi_mod, psi_protect_name => psi_dovrl_save_vect + use psb_realloc_mod + use psb_d_base_vect_mod + + implicit none + + class(psb_d_base_vect_type) :: x + real(psb_dpk_), allocatable :: xs(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + + ! locals + integer :: ictxt, np, me, err_act, i, idx, isz + character(len=20) :: name, ch_err + + name='psi_dovrl_saver1' + if (psb_get_errstatus() /= 0) return + info = psb_success_ + call psb_erractionsave(err_act) + ictxt = desc_a%get_context() + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + isz = size(desc_a%ovrlap_elem,1) + call psb_realloc(isz,xs,info) + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + endif + + call x%gth(isz,desc_a%ovrlap_elem(:,1),xs) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return +end subroutine psi_dovrl_save_vect + +subroutine psi_covrl_save_vect(x,xs,desc_a,info) + use psi_mod, psi_protect_name => psi_covrl_save_vect + use psb_realloc_mod + use psb_c_base_vect_mod + + implicit none + + class(psb_c_base_vect_type) :: x + complex(psb_spk_), allocatable :: xs(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + + ! locals + integer :: ictxt, np, me, err_act, i, idx, isz + character(len=20) :: name, ch_err + + name='psi_sovrl_saver1' + if (psb_get_errstatus() /= 0) return + info = psb_success_ + call psb_erractionsave(err_act) + ictxt = desc_a%get_context() + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + isz = size(desc_a%ovrlap_elem,1) + call psb_realloc(isz,xs,info) + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + endif + + call x%gth(isz,desc_a%ovrlap_elem(:,1),xs) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return +end subroutine psi_covrl_save_vect + +subroutine psi_zovrl_save_vect(x,xs,desc_a,info) + use psi_mod, psi_protect_name => psi_zovrl_save_vect + use psb_realloc_mod + use psb_z_base_vect_mod + + implicit none + + class(psb_z_base_vect_type) :: x + complex(psb_dpk_), allocatable :: xs(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + + ! locals + integer :: ictxt, np, me, err_act, i, idx, isz + character(len=20) :: name, ch_err + + name='psi_dovrl_saver1' + if (psb_get_errstatus() /= 0) return + info = psb_success_ + call psb_erractionsave(err_act) + ictxt = desc_a%get_context() + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + isz = size(desc_a%ovrlap_elem,1) + call psb_realloc(isz,xs,info) + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + endif + + call x%gth(isz,desc_a%ovrlap_elem(:,1),xs) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return +end subroutine psi_zovrl_save_vect diff --git a/base/internals/psi_ovrl_upd.f90 b/base/internals/psi_ovrl_upd.f90 index dcf2dad7a..2967acaeb 100644 --- a/base/internals/psi_ovrl_upd.f90 +++ b/base/internals/psi_ovrl_upd.f90 @@ -727,3 +727,334 @@ subroutine psi_iovrl_updr2(x,desc_a,update,info) return end subroutine psi_iovrl_updr2 + +subroutine psi_sovrl_upd_vect(x,desc_a,update,info) + use psi_mod, psi_protect_name => psi_sovrl_upd_vect + use psb_realloc_mod + use psb_s_base_vect_mod + + implicit none + + class(psb_s_base_vect_type) :: x + type(psb_desc_type), intent(in) :: desc_a + integer, intent(in) :: update + integer, intent(out) :: info + + ! locals + real(psb_spk_), allocatable :: xs(:) + integer :: ictxt, np, me, err_act, i, idx, ndm, nx + character(len=20) :: name, ch_err + + + name='psi_sovrl_updr1' + if (psb_get_errstatus() /= 0) return + info = psb_success_ + call psb_erractionsave(err_act) + ictxt = desc_a%get_context() + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + nx = size(desc_a%ovrlap_elem,1) + call psb_realloc(nx,xs,info) + if (info /= psb_success_) then + info = psb_err_alloc_Dealloc_ + call psb_errpush(info,name) + goto 9999 + end if + + if (update /= psb_sum_) then + call x%gth(nx,desc_a%ovrlap_elem(:,1),xs) + ! switch on update type + + select case (update) + case(psb_square_root_) + do i=1,nx + ndm = desc_a%ovrlap_elem(i,2) + xs(i) = xs(i)/sqrt(real(ndm)) + end do + case(psb_avg_) + do i=1,nx + ndm = desc_a%ovrlap_elem(i,2) + xs(i) = xs(i)/real(ndm) + end do + case(psb_setzero_) + do i=1,nx + if (me /= desc_a%ovrlap_elem(i,3))& + & xs(i) = szero + end do + case(psb_sum_) + ! do nothing + + case default + ! wrong value for choice argument + info = psb_err_iarg_invalid_value_ + call psb_errpush(info,name,i_err=(/3,update,0,0,0/)) + goto 9999 + end select + call x%sct(nx,desc_a%ovrlap_elem(:,1),xs,szero) + 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(ictxt) + return + end if + return +end subroutine psi_sovrl_upd_vect + +subroutine psi_dovrl_upd_vect(x,desc_a,update,info) + use psi_mod, psi_protect_name => psi_dovrl_upd_vect + use psb_realloc_mod + use psb_d_base_vect_mod + + implicit none + + class(psb_d_base_vect_type) :: x + type(psb_desc_type), intent(in) :: desc_a + integer, intent(in) :: update + integer, intent(out) :: info + + ! locals + real(psb_dpk_), allocatable :: xs(:) + integer :: ictxt, np, me, err_act, i, idx, ndm, nx + character(len=20) :: name, ch_err + + + name='psi_dovrl_updr1' + if (psb_get_errstatus() /= 0) return + info = psb_success_ + call psb_erractionsave(err_act) + ictxt = desc_a%get_context() + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + nx = size(desc_a%ovrlap_elem,1) + call psb_realloc(nx,xs,info) + if (info /= psb_success_) then + info = psb_err_alloc_Dealloc_ + call psb_errpush(info,name) + goto 9999 + end if + + if (update /= psb_sum_) then + call x%gth(nx,desc_a%ovrlap_elem(:,1),xs) + ! switch on update type + + select case (update) + case(psb_square_root_) + do i=1,nx + ndm = desc_a%ovrlap_elem(i,2) + xs(i) = xs(i)/sqrt(dble(ndm)) + end do + case(psb_avg_) + do i=1,nx + ndm = desc_a%ovrlap_elem(i,2) + xs(i) = xs(i)/dble(ndm) + end do + case(psb_setzero_) + do i=1,nx + if (me /= desc_a%ovrlap_elem(i,3))& + & xs(i) = dzero + end do + case(psb_sum_) + ! do nothing + + case default + ! wrong value for choice argument + info = psb_err_iarg_invalid_value_ + call psb_errpush(info,name,i_err=(/3,update,0,0,0/)) + goto 9999 + end select + call x%sct(nx,desc_a%ovrlap_elem(:,1),xs,dzero) + 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(ictxt) + return + end if + return +end subroutine psi_dovrl_upd_vect + + +subroutine psi_covrl_upd_vect(x,desc_a,update,info) + use psi_mod, psi_protect_name => psi_covrl_upd_vect + use psb_realloc_mod + use psb_c_base_vect_mod + + implicit none + + class(psb_c_base_vect_type) :: x + type(psb_desc_type), intent(in) :: desc_a + integer, intent(in) :: update + integer, intent(out) :: info + + ! locals + complex(psb_spk_), allocatable :: xs(:) + integer :: ictxt, np, me, err_act, i, idx, ndm, nx + character(len=20) :: name, ch_err + + + name='psi_covrl_updr1' + if (psb_get_errstatus() /= 0) return + info = psb_success_ + call psb_erractionsave(err_act) + ictxt = desc_a%get_context() + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + nx = size(desc_a%ovrlap_elem,1) + call psb_realloc(nx,xs,info) + if (info /= psb_success_) then + info = psb_err_alloc_Dealloc_ + call psb_errpush(info,name) + goto 9999 + end if + + if (update /= psb_sum_) then + call x%gth(nx,desc_a%ovrlap_elem(:,1),xs) + ! switch on update type + + select case (update) + case(psb_square_root_) + do i=1,nx + ndm = desc_a%ovrlap_elem(i,2) + xs(i) = xs(i)/sqrt(real(ndm)) + end do + case(psb_avg_) + do i=1,nx + ndm = desc_a%ovrlap_elem(i,2) + xs(i) = xs(i)/real(ndm) + end do + case(psb_setzero_) + do i=1,nx + if (me /= desc_a%ovrlap_elem(i,3))& + & xs(i) = szero + end do + case(psb_sum_) + ! do nothing + + case default + ! wrong value for choice argument + info = psb_err_iarg_invalid_value_ + call psb_errpush(info,name,i_err=(/3,update,0,0,0/)) + goto 9999 + end select + call x%sct(nx,desc_a%ovrlap_elem(:,1),xs,czero) + 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(ictxt) + return + end if + return +end subroutine psi_covrl_upd_vect + +subroutine psi_zovrl_upd_vect(x,desc_a,update,info) + use psi_mod, psi_protect_name => psi_zovrl_upd_vect + use psb_realloc_mod + use psb_z_base_vect_mod + + implicit none + + class(psb_z_base_vect_type) :: x + type(psb_desc_type), intent(in) :: desc_a + integer, intent(in) :: update + integer, intent(out) :: info + + ! locals + complex(psb_dpk_), allocatable :: xs(:) + integer :: ictxt, np, me, err_act, i, idx, ndm, nx + character(len=20) :: name, ch_err + + + name='psi_zovrl_updr1' + if (psb_get_errstatus() /= 0) return + info = psb_success_ + call psb_erractionsave(err_act) + ictxt = desc_a%get_context() + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + nx = size(desc_a%ovrlap_elem,1) + call psb_realloc(nx,xs,info) + if (info /= psb_success_) then + info = psb_err_alloc_Dealloc_ + call psb_errpush(info,name) + goto 9999 + end if + + if (update /= psb_sum_) then + call x%gth(nx,desc_a%ovrlap_elem(:,1),xs) + ! switch on update type + + select case (update) + case(psb_square_root_) + do i=1,nx + ndm = desc_a%ovrlap_elem(i,2) + xs(i) = xs(i)/sqrt(dble(ndm)) + end do + case(psb_avg_) + do i=1,nx + ndm = desc_a%ovrlap_elem(i,2) + xs(i) = xs(i)/dble(ndm) + end do + case(psb_setzero_) + do i=1,nx + if (me /= desc_a%ovrlap_elem(i,3))& + & xs(i) = dzero + end do + case(psb_sum_) + ! do nothing + + case default + ! wrong value for choice argument + info = psb_err_iarg_invalid_value_ + call psb_errpush(info,name,i_err=(/3,update,0,0,0/)) + goto 9999 + end select + call x%sct(nx,desc_a%ovrlap_elem(:,1),xs,zzero) + 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(ictxt) + return + end if + return +end subroutine psi_zovrl_upd_vect + + diff --git a/base/internals/psi_sswapdata.F90 b/base/internals/psi_sswapdata.F90 index 930c658d8..b812294b3 100644 --- a/base/internals/psi_sswapdata.F90 +++ b/base/internals/psi_sswapdata.F90 @@ -81,7 +81,6 @@ ! psb_comm_mov_ use ovr_mst_idx ! ! -! subroutine psi_sswapdatam(flag,n,beta,y,desc_a,work,info,data) use psi_mod, psb_protect_name => psi_sswapdatam @@ -331,7 +330,8 @@ subroutine psi_sswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) else if (proc_to_comm == me) then if (nesd /= nerv) then - write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd + write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',& + & nerv,nesd end if rcvbuf(rcv_pt:rcv_pt+n*nerv-1) = sndbuf(snd_pt:snd_pt+n*nesd-1) end if @@ -998,3 +998,438 @@ subroutine psi_sswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i end if return end subroutine psi_sswapidxv + +subroutine psi_sswapdata_vect(flag,beta,y,desc_a,work,info,data) + + use psi_mod, psb_protect_name => psi_sswapdata_vect + use psb_s_base_vect_mod + use psb_error_mod + use psb_descriptor_type + use psb_penv_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + + integer, intent(in) :: flag + integer, intent(out) :: info + class(psb_s_base_vect_type) :: y + real(psb_spk_) :: beta + real(psb_spk_), target :: work(:) + type(psb_desc_type),target :: desc_a + integer, optional :: data + + ! locals + integer :: ictxt, np, me, icomm, idxs, idxr, totxch, data_, err_act + integer, pointer :: d_idx(:) + character(len=20) :: name + + info=psb_success_ + name='psi_swap_datav' + call psb_erractionsave(err_act) + + ictxt=desc_a%get_context() + call psb_info(ictxt,me,np) + if (np == -1) then + info=psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (.not.psb_is_asb_desc(desc_a)) then + info=psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + endif + + icomm = desc_a%get_mpic() + + if(present(data)) then + data_ = data + else + data_ = psb_comm_halo_ + end if + + call psb_cd_get_list(data_,desc_a,d_idx,totxch,idxr,idxs,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,a_err='psb_cd_get_list') + goto 9999 + end if + + call psi_swapdata(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) + if (info /= psb_success_) 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(ictxt) + return + end if + return +end subroutine psi_sswapdata_vect + + +subroutine psi_sswapidx_vect(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info) + + use psi_mod, psb_protect_name => psi_sswapidx_vect + use psb_error_mod + use psb_descriptor_type + use psb_penv_mod + use psb_s_base_vect_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + + integer, intent(in) :: ictxt,icomm,flag + integer, intent(out) :: info + class(psb_s_base_vect_type) :: y + real(psb_spk_) :: beta + real(psb_spk_), target :: work(:) + integer, intent(in) :: idx(:),totxch,totsnd, totrcv + + ! locals + integer :: np, me, nesd, nerv,& + & proc_to_comm, p2ptag, p2pstat(mpi_status_size),& + & iret, err_act, i, totsnd_, totrcv_,& + & idx_pt, snd_pt, rcv_pt, n, pnti, data_ + + integer, allocatable, dimension(:) :: bsdidx, brvidx,& + & sdsz, rvsz, prcid, rvhd, sdhd + integer :: int_err(5) + logical :: swap_mpi, swap_sync, swap_send, swap_recv,& + & albf,do_send,do_recv + logical, parameter :: usersend=.false. + + real(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf +#ifdef HAVE_VOLATILE + volatile :: sndbuf, rcvbuf +#endif + character(len=20) :: name + + info=psb_success_ + name='psi_swap_datav' + call psb_erractionsave(err_act) + + call psb_info(ictxt,me,np) + if (np == -1) then + info=psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + n=1 + + swap_mpi = iand(flag,psb_swap_mpi_) /= 0 + swap_sync = iand(flag,psb_swap_sync_) /= 0 + swap_send = iand(flag,psb_swap_send_) /= 0 + swap_recv = iand(flag,psb_swap_recv_) /= 0 + do_send = swap_mpi .or. swap_sync .or. swap_send + do_recv = swap_mpi .or. swap_sync .or. swap_recv + + totrcv_ = totrcv * n + totsnd_ = totsnd * n + + if (swap_mpi) then + allocate(sdsz(0:np-1), rvsz(0:np-1), bsdidx(0:np-1),& + & brvidx(0:np-1), rvhd(0:np-1), sdhd(0:np-1), prcid(0:np-1),& + & stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + + rvhd(:) = mpi_request_null + sdsz(:) = 0 + rvsz(:) = 0 + + ! prepare info for communications + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + call psb_get_rank(prcid(proc_to_comm),ictxt,proc_to_comm) + + brvidx(proc_to_comm) = rcv_pt + rvsz(proc_to_comm) = nerv + + bsdidx(proc_to_comm) = snd_pt + sdsz(proc_to_comm) = nesd + + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + + end do + + else + allocate(rvhd(totxch),prcid(totxch),stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + end if + + + totrcv_ = max(totrcv_,1) + totsnd_ = max(totsnd_,1) + if((totrcv_+totsnd_) < size(work)) then + sndbuf => work(1:totsnd_) + rcvbuf => work(totsnd_+1:totsnd_+totrcv_) + albf=.false. + else + allocate(sndbuf(totsnd_),rcvbuf(totrcv_), stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + albf=.true. + end if + + + if (do_send) then + + ! Pack send buffers + pnti = 1 + snd_pt = 1 + do i=1, totxch + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + idx_pt = 1+pnti+nerv+psb_n_elem_send_ + call y%gth(nesd,idx(idx_pt:idx_pt+nesd-1),& + & sndbuf(snd_pt:snd_pt+nesd-1)) + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + end if + + ! Case SWAP_MPI + if (swap_mpi) then + + ! swap elements using mpi_alltoallv + call mpi_alltoallv(sndbuf,sdsz,bsdidx,& + & mpi_real,rcvbuf,rvsz,& + & brvidx,mpi_real,icomm,iret) + if(iret /= mpi_success) then + int_err(1) = iret + info=psb_err_mpi_error_ + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + else if (swap_sync) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + + if (proc_to_comm < me) then + if (nesd>0) call psb_snd(ictxt,& + & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) + if (nerv>0) call psb_rcv(ictxt,& + & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) + else if (proc_to_comm > me) then + if (nerv>0) call psb_rcv(ictxt,& + & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) + if (nesd>0) call psb_snd(ictxt,& + & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) + else if (proc_to_comm == me) then + if (nesd /= nerv) then + write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',& + & nerv,nesd + end if + rcvbuf(rcv_pt:rcv_pt+nerv-1) = sndbuf(snd_pt:snd_pt+nesd-1) + end if + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + + else if (swap_send .and. swap_recv) then + + ! First I post all the non blocking receives + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + + call psb_get_rank(prcid(i),ictxt,proc_to_comm) + if ((nerv>0).and.(proc_to_comm /= me)) then + p2ptag = psb_real_swap_tag + call mpi_irecv(rcvbuf(rcv_pt),nerv,& + & mpi_real,prcid(i),& + & p2ptag, icomm,rvhd(i),iret) + end if + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + + ! Then I post all the blocking sends + if (usersend) call mpi_barrier(icomm,info) + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + + p2ptag=psb_real_swap_tag + + if ((nesd>0).and.(proc_to_comm /= me)) then + if (usersend) then + call mpi_rsend(sndbuf(snd_pt),nesd,& + & mpi_real,prcid(i),& + & p2ptag,icomm,iret) + else + call mpi_send(sndbuf(snd_pt),nesd,& + & mpi_real,prcid(i),& + & p2ptag,icomm,iret) + end if + + if(iret /= mpi_success) then + int_err(1) = iret + info=psb_err_mpi_error_ + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + end if + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + + pnti = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + + p2ptag =psb_real_swap_tag + + if ((proc_to_comm /= me).and.(nerv>0)) then + call mpi_wait(rvhd(i),p2pstat,iret) + if(iret /= mpi_success) then + int_err(1) = iret + info=psb_err_mpi_error_ + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + else if (proc_to_comm == me) then + if (nesd /= nerv) then + write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',& + & nerv,nesd + end if + rcvbuf(rcv_pt:rcv_pt+nerv-1) = sndbuf(snd_pt:snd_pt+nesd-1) + end if + pnti = pnti + nerv + nesd + 3 + end do + + + else if (swap_send) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + if (nesd>0) call psb_snd(ictxt,& + & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + else if (swap_recv) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + if (nerv>0) call psb_rcv(ictxt,& + & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + end if + + if (do_recv) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + idx_pt = 1+pnti+psb_n_elem_recv_ + call y%sct(nerv,idx(idx_pt:idx_pt+nerv-1),& + & rcvbuf(rcv_pt:rcv_pt+nerv-1),beta) + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + end if + + if (swap_mpi) then + deallocate(sdsz,rvsz,bsdidx,brvidx,rvhd,prcid,sdhd,& + & stat=info) + else + deallocate(rvhd,prcid,stat=info) + end if + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + if(albf) deallocate(sndbuf,rcvbuf,stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,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(ictxt) + return + end if + return +end subroutine psi_sswapidx_vect + diff --git a/base/internals/psi_sswaptran.F90 b/base/internals/psi_sswaptran.F90 index e675851f8..ff9069009 100644 --- a/base/internals/psi_sswaptran.F90 +++ b/base/internals/psi_sswaptran.F90 @@ -682,6 +682,9 @@ subroutine psi_stranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i logical, parameter :: usersend=.false. real(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf +#ifdef HAVE_VOLATILE + volatile :: sndbuf, rcvbuf +#endif character(len=20) :: name info=psb_success_ @@ -1006,3 +1009,448 @@ subroutine psi_stranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i end if return end subroutine psi_stranidxv + + +subroutine psi_sswaptran_vect(flag,beta,y,desc_a,work,info,data) + + use psi_mod, psb_protect_name => psi_sswaptran_vect + use psb_error_mod + use psb_descriptor_type + use psb_penv_mod + use psb_s_base_vect_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + + integer, intent(in) :: flag + integer, intent(out) :: info + class(psb_s_base_vect_type) :: y + real(psb_spk_) :: beta + real(psb_spk_), target :: work(:) + type(psb_desc_type),target :: desc_a + integer, optional :: data + + ! locals + integer :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ + integer, pointer :: d_idx(:) + integer :: int_err(5) + character(len=20) :: name + + info=psb_success_ + name='psi_swap_tranv' + call psb_erractionsave(err_act) + + ictxt = desc_a%get_context() + icomm = desc_a%get_mpic() + call psb_info(ictxt,me,np) + if (np == -1) then + info=psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (.not.psb_is_asb_desc(desc_a)) then + info=psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + endif + + if (present(data)) then + data_ = data + else + data_ = psb_comm_halo_ + end if + + call psb_cd_get_list(data_,desc_a,d_idx,totxch,idxr,idxs,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,a_err='psb_cd_get_list') + goto 9999 + end if + + call psi_swaptran(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) + if (info /= psb_success_) 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(ictxt) + return + end if + return +end subroutine psi_sswaptran_vect + + + +subroutine psi_stranidx_vect(ictxt,icomm,flag,beta,y,idx,& + & totxch,totsnd,totrcv,work,info) + + use psi_mod, psb_protect_name => psi_stranidx_vect + use psb_error_mod + use psb_descriptor_type + use psb_penv_mod + use psb_s_base_vect_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + + integer, intent(in) :: ictxt,icomm,flag + integer, intent(out) :: info + class(psb_s_base_vect_type) :: y + real(psb_spk_) :: beta + real(psb_spk_), target :: work(:) + integer, intent(in) :: idx(:),totxch,totsnd, totrcv + + ! locals + integer :: np, me, nesd, nerv,& + & proc_to_comm, p2ptag, p2pstat(mpi_status_size),& + & iret, err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti, data_, n + integer, allocatable, dimension(:) :: bsdidx, brvidx,& + & sdsz, rvsz, prcid, rvhd, sdhd + integer :: int_err(5) + logical :: swap_mpi, swap_sync, swap_send, swap_recv,& + & albf,do_send,do_recv + logical, parameter :: usersend=.false. + + real(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf +#ifdef HAVE_VOLATILE + volatile :: sndbuf, rcvbuf +#endif + character(len=20) :: name + + info=psb_success_ + name='psi_swap_tran' + call psb_erractionsave(err_act) + + call psb_info(ictxt,me,np) + if (np == -1) then + info=psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + n=1 + swap_mpi = iand(flag,psb_swap_mpi_) /= 0 + swap_sync = iand(flag,psb_swap_sync_) /= 0 + swap_send = iand(flag,psb_swap_send_) /= 0 + swap_recv = iand(flag,psb_swap_recv_) /= 0 + do_send = swap_mpi .or. swap_sync .or. swap_send + do_recv = swap_mpi .or. swap_sync .or. swap_recv + + totrcv_ = totrcv * n + totsnd_ = totsnd * n + + if (swap_mpi) then + allocate(sdsz(0:np-1), rvsz(0:np-1), bsdidx(0:np-1),& + & brvidx(0:np-1), rvhd(0:np-1), sdhd(0:np-1), prcid(0:np-1),& + & stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + + rvhd(:) = mpi_request_null + sdsz(:) = 0 + rvsz(:) = 0 + + ! prepare info for communications + + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + call psb_get_rank(prcid(proc_to_comm),ictxt,proc_to_comm) + + brvidx(proc_to_comm) = rcv_pt + rvsz(proc_to_comm) = nerv + + bsdidx(proc_to_comm) = snd_pt + sdsz(proc_to_comm) = nesd + + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + + end do + + else + allocate(rvhd(totxch),prcid(totxch),stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + end if + + + totrcv_ = max(totrcv_,1) + totsnd_ = max(totsnd_,1) + if((totrcv_+totsnd_) < size(work)) then + sndbuf => work(1:totsnd_) + rcvbuf => work(totsnd_+1:totsnd_+totrcv_) + albf=.false. + else + allocate(sndbuf(totsnd_),rcvbuf(totrcv_), stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + albf=.true. + end if + + + if (do_send) then + + ! Pack send buffers + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + idx_pt = 1+pnti+psb_n_elem_recv_ + + call y%gth(nerv,idx(idx_pt:idx_pt+nerv-1),& + & rcvbuf(rcv_pt:rcv_pt+nerv-1)) + + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + end if + + ! Case SWAP_MPI + if (swap_mpi) then + + ! swap elements using mpi_alltoallv + call mpi_alltoallv(rcvbuf,rvsz,brvidx,& + & mpi_real,& + & sndbuf,sdsz,bsdidx,mpi_real,icomm,iret) + if(iret /= mpi_success) then + int_err(1) = iret + info=psb_err_mpi_error_ + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + else if (swap_sync) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + + if (proc_to_comm < me) then + if (nerv>0) call psb_snd(ictxt,& + & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) + if (nesd>0) call psb_rcv(ictxt,& + & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) + else if (proc_to_comm > me) then + if (nesd>0) call psb_rcv(ictxt,& + & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) + if (nerv>0) call psb_snd(ictxt,& + & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) + else if (proc_to_comm == me) then + if (nesd /= nerv) then + write(psb_err_unit,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd + end if + sndbuf(snd_pt:snd_pt+nesd-1) = rcvbuf(rcv_pt:rcv_pt+nerv-1) + end if + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + + end do + + + else if (swap_send .and. swap_recv) then + + ! First I post all the non blocking receives + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + call psb_get_rank(prcid(i),ictxt,proc_to_comm) + if ((nesd>0).and.(proc_to_comm /= me)) then + p2ptag = psb_real_swap_tag + call mpi_irecv(sndbuf(snd_pt),nesd,& + & mpi_real,prcid(i),& + & p2ptag,icomm,rvhd(i),iret) + end if + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + + ! Then I post all the blocking sends + if (usersend) call mpi_barrier(icomm,info) + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + + if ((nerv>0).and.(proc_to_comm /= me)) then + p2ptag=psb_real_swap_tag + if (usersend) then + call mpi_rsend(rcvbuf(rcv_pt),nerv,& + & mpi_real,prcid(i),& + & p2ptag, icomm,iret) + else + call mpi_send(rcvbuf(rcv_pt),nerv,& + & mpi_real,prcid(i),& + & p2ptag, icomm,iret) + end if + + if(iret /= mpi_success) then + int_err(1) = iret + info=psb_err_mpi_error_ + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + end if + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + + end do + + + pnti = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + p2ptag = psb_real_swap_tag + + if ((proc_to_comm /= me).and.(nesd>0)) then + call mpi_wait(rvhd(i),p2pstat,iret) + if(iret /= mpi_success) then + int_err(1) = iret + info=psb_err_mpi_error_ + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + else if (proc_to_comm == me) then + if (nesd /= nerv) then + write(psb_err_unit,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd + end if + sndbuf(snd_pt:snd_pt+nesd-1) = rcvbuf(rcv_pt:rcv_pt+nerv-1) + end if + pnti = pnti + nerv + nesd + 3 + end do + + + else if (swap_send) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + if (nerv>0) call psb_snd(ictxt,& + & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + + end do + + else if (swap_recv) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + if (nesd>0) call psb_rcv(ictxt,& + & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + + end do + + end if + + + if (do_recv) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + idx_pt = 1+pnti+nerv+psb_n_elem_send_ + call y%sct(nesd,idx(idx_pt:idx_pt+nesd-1),& + & sndbuf(snd_pt:snd_pt+nesd-1),beta) + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + end if + + + if (swap_mpi) then + deallocate(sdsz,rvsz,bsdidx,brvidx,rvhd,prcid,sdhd,& + & stat=info) + else + deallocate(rvhd,prcid,stat=info) + end if + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + if(albf) deallocate(sndbuf,rcvbuf,stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,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(ictxt) + return + end if + return +end subroutine psi_stranidx_vect + + + diff --git a/base/internals/psi_zswapdata.F90 b/base/internals/psi_zswapdata.F90 index 5e0fc8bd3..27fda0f9c 100644 --- a/base/internals/psi_zswapdata.F90 +++ b/base/internals/psi_zswapdata.F90 @@ -330,7 +330,8 @@ subroutine psi_zswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work & sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm) else if (proc_to_comm == me) then if (nesd /= nerv) then - write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd + write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',& + & nerv,nesd end if rcvbuf(rcv_pt:rcv_pt+n*nerv-1) = sndbuf(snd_pt:snd_pt+n*nesd-1) end if @@ -998,3 +999,438 @@ subroutine psi_zswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i end if return end subroutine psi_zswapidxv + +subroutine psi_zswapdata_vect(flag,beta,y,desc_a,work,info,data) + + use psi_mod, psb_protect_name => psi_zswapdata_vect + use psb_z_base_vect_mod + use psb_error_mod + use psb_descriptor_type + use psb_penv_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + + integer, intent(in) :: flag + integer, intent(out) :: info + class(psb_z_base_vect_type) :: y + complex(psb_dpk_) :: beta + complex(psb_dpk_), target :: work(:) + type(psb_desc_type),target :: desc_a + integer, optional :: data + + ! locals + integer :: ictxt, np, me, icomm, idxs, idxr, totxch, data_, err_act + integer, pointer :: d_idx(:) + character(len=20) :: name + + info=psb_success_ + name='psi_swap_datav' + call psb_erractionsave(err_act) + + ictxt=desc_a%get_context() + call psb_info(ictxt,me,np) + if (np == -1) then + info=psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (.not.psb_is_asb_desc(desc_a)) then + info=psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + endif + + icomm = desc_a%get_mpic() + + if(present(data)) then + data_ = data + else + data_ = psb_comm_halo_ + end if + + call psb_cd_get_list(data_,desc_a,d_idx,totxch,idxr,idxs,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,a_err='psb_cd_get_list') + goto 9999 + end if + + call psi_swapdata(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) + if (info /= psb_success_) 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(ictxt) + return + end if + return +end subroutine psi_zswapdata_vect + + +subroutine psi_zswapidx_vect(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info) + + use psi_mod, psb_protect_name => psi_zswapidx_vect + use psb_error_mod + use psb_descriptor_type + use psb_penv_mod + use psb_z_base_vect_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + + integer, intent(in) :: ictxt,icomm,flag + integer, intent(out) :: info + class(psb_z_base_vect_type) :: y + complex(psb_dpk_) :: beta + complex(psb_dpk_), target :: work(:) + integer, intent(in) :: idx(:),totxch,totsnd, totrcv + + ! locals + integer :: np, me, nesd, nerv,& + & proc_to_comm, p2ptag, p2pstat(mpi_status_size),& + & iret, err_act, i, totsnd_, totrcv_,& + & idx_pt, snd_pt, rcv_pt, n, pnti, data_ + + integer, allocatable, dimension(:) :: bsdidx, brvidx,& + & sdsz, rvsz, prcid, rvhd, sdhd + integer :: int_err(5) + logical :: swap_mpi, swap_sync, swap_send, swap_recv,& + & albf,do_send,do_recv + logical, parameter :: usersend=.false. + + complex(psb_dpk_), pointer, dimension(:) :: sndbuf, rcvbuf +#ifdef HAVE_VOLATILE + volatile :: sndbuf, rcvbuf +#endif + character(len=20) :: name + + info=psb_success_ + name='psi_swap_datav' + call psb_erractionsave(err_act) + + call psb_info(ictxt,me,np) + if (np == -1) then + info=psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + n=1 + + swap_mpi = iand(flag,psb_swap_mpi_) /= 0 + swap_sync = iand(flag,psb_swap_sync_) /= 0 + swap_send = iand(flag,psb_swap_send_) /= 0 + swap_recv = iand(flag,psb_swap_recv_) /= 0 + do_send = swap_mpi .or. swap_sync .or. swap_send + do_recv = swap_mpi .or. swap_sync .or. swap_recv + + totrcv_ = totrcv * n + totsnd_ = totsnd * n + + if (swap_mpi) then + allocate(sdsz(0:np-1), rvsz(0:np-1), bsdidx(0:np-1),& + & brvidx(0:np-1), rvhd(0:np-1), sdhd(0:np-1), prcid(0:np-1),& + & stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + + rvhd(:) = mpi_request_null + sdsz(:) = 0 + rvsz(:) = 0 + + ! prepare info for communications + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + call psb_get_rank(prcid(proc_to_comm),ictxt,proc_to_comm) + + brvidx(proc_to_comm) = rcv_pt + rvsz(proc_to_comm) = nerv + + bsdidx(proc_to_comm) = snd_pt + sdsz(proc_to_comm) = nesd + + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + + end do + + else + allocate(rvhd(totxch),prcid(totxch),stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + end if + + + totrcv_ = max(totrcv_,1) + totsnd_ = max(totsnd_,1) + if((totrcv_+totsnd_) < size(work)) then + sndbuf => work(1:totsnd_) + rcvbuf => work(totsnd_+1:totsnd_+totrcv_) + albf=.false. + else + allocate(sndbuf(totsnd_),rcvbuf(totrcv_), stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + albf=.true. + end if + + + if (do_send) then + + ! Pack send buffers + pnti = 1 + snd_pt = 1 + do i=1, totxch + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + idx_pt = 1+pnti+nerv+psb_n_elem_send_ + call y%gth(nesd,idx(idx_pt:idx_pt+nesd-1),& + & sndbuf(snd_pt:snd_pt+nesd-1)) + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + end if + + ! Case SWAP_MPI + if (swap_mpi) then + + ! swap elements using mpi_alltoallv + call mpi_alltoallv(sndbuf,sdsz,bsdidx,& + & mpi_double_complex,rcvbuf,rvsz,& + & brvidx,mpi_double_complex,icomm,iret) + if(iret /= mpi_success) then + int_err(1) = iret + info=psb_err_mpi_error_ + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + else if (swap_sync) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + + if (proc_to_comm < me) then + if (nesd>0) call psb_snd(ictxt,& + & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) + if (nerv>0) call psb_rcv(ictxt,& + & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) + else if (proc_to_comm > me) then + if (nerv>0) call psb_rcv(ictxt,& + & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) + if (nesd>0) call psb_snd(ictxt,& + & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) + else if (proc_to_comm == me) then + if (nesd /= nerv) then + write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',& + & nerv,nesd + end if + rcvbuf(rcv_pt:rcv_pt+nerv-1) = sndbuf(snd_pt:snd_pt+nesd-1) + end if + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + + else if (swap_send .and. swap_recv) then + + ! First I post all the non blocking receives + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + + call psb_get_rank(prcid(i),ictxt,proc_to_comm) + if ((nerv>0).and.(proc_to_comm /= me)) then + p2ptag = psb_dcomplex_swap_tag + call mpi_irecv(rcvbuf(rcv_pt),nerv,& + & mpi_double_complex,prcid(i),& + & p2ptag, icomm,rvhd(i),iret) + end if + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + + ! Then I post all the blocking sends + if (usersend) call mpi_barrier(icomm,info) + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + + p2ptag=psb_dcomplex_swap_tag + + if ((nesd>0).and.(proc_to_comm /= me)) then + if (usersend) then + call mpi_rsend(sndbuf(snd_pt),nesd,& + & mpi_double_complex,prcid(i),& + & p2ptag,icomm,iret) + else + call mpi_send(sndbuf(snd_pt),nesd,& + & mpi_double_complex,prcid(i),& + & p2ptag,icomm,iret) + end if + + if(iret /= mpi_success) then + int_err(1) = iret + info=psb_err_mpi_error_ + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + end if + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + + pnti = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + + p2ptag =psb_dcomplex_swap_tag + + if ((proc_to_comm /= me).and.(nerv>0)) then + call mpi_wait(rvhd(i),p2pstat,iret) + if(iret /= mpi_success) then + int_err(1) = iret + info=psb_err_mpi_error_ + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + else if (proc_to_comm == me) then + if (nesd /= nerv) then + write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',& + & nerv,nesd + end if + rcvbuf(rcv_pt:rcv_pt+nerv-1) = sndbuf(snd_pt:snd_pt+nesd-1) + end if + pnti = pnti + nerv + nesd + 3 + end do + + + else if (swap_send) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + if (nesd>0) call psb_snd(ictxt,& + & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + else if (swap_recv) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + if (nerv>0) call psb_rcv(ictxt,& + & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + end if + + if (do_recv) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + idx_pt = 1+pnti+psb_n_elem_recv_ + call y%sct(nerv,idx(idx_pt:idx_pt+nerv-1),& + & rcvbuf(rcv_pt:rcv_pt+nerv-1),beta) + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + end if + + if (swap_mpi) then + deallocate(sdsz,rvsz,bsdidx,brvidx,rvhd,prcid,sdhd,& + & stat=info) + else + deallocate(rvhd,prcid,stat=info) + end if + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + if(albf) deallocate(sndbuf,rcvbuf,stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,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(ictxt) + return + end if + return +end subroutine psi_zswapidx_vect + diff --git a/base/internals/psi_zswaptran.F90 b/base/internals/psi_zswaptran.F90 index 25015094e..0369e0372 100644 --- a/base/internals/psi_zswaptran.F90 +++ b/base/internals/psi_zswaptran.F90 @@ -309,8 +309,8 @@ subroutine psi_ztranidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work ! swap elements using mpi_alltoallv call mpi_alltoallv(rcvbuf,rvsz,brvidx,& - & mpi_double_precision,& - & sndbuf,sdsz,bsdidx,mpi_double_precision,icomm,iret) + & mpi_double_complex,& + & sndbuf,sdsz,bsdidx,mpi_double_complex,icomm,iret) if(iret /= mpi_success) then int_err(1) = iret info=psb_err_mpi_error_ @@ -798,8 +798,8 @@ subroutine psi_ztranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i ! swap elements using mpi_alltoallv call mpi_alltoallv(rcvbuf,rvsz,brvidx,& - & mpi_double_precision,& - & sndbuf,sdsz,bsdidx,mpi_double_precision,icomm,iret) + & mpi_double_complex,& + & sndbuf,sdsz,bsdidx,mpi_double_complex,icomm,iret) if(iret /= mpi_success) then int_err(1) = iret info=psb_err_mpi_error_ @@ -1009,3 +1009,448 @@ subroutine psi_ztranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i end if return end subroutine psi_ztranidxv + + +subroutine psi_zswaptran_vect(flag,beta,y,desc_a,work,info,data) + + use psi_mod, psb_protect_name => psi_zswaptran_vect + use psb_error_mod + use psb_descriptor_type + use psb_penv_mod + use psb_z_base_vect_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + + integer, intent(in) :: flag + integer, intent(out) :: info + class(psb_z_base_vect_type) :: y + complex(psb_dpk_) :: beta + complex(psb_dpk_), target :: work(:) + type(psb_desc_type),target :: desc_a + integer, optional :: data + + ! locals + integer :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ + integer, pointer :: d_idx(:) + integer :: int_err(5) + character(len=20) :: name + + info=psb_success_ + name='psi_swap_tranv' + call psb_erractionsave(err_act) + + ictxt = desc_a%get_context() + icomm = desc_a%get_mpic() + call psb_info(ictxt,me,np) + if (np == -1) then + info=psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (.not.psb_is_asb_desc(desc_a)) then + info=psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + endif + + if (present(data)) then + data_ = data + else + data_ = psb_comm_halo_ + end if + + call psb_cd_get_list(data_,desc_a,d_idx,totxch,idxr,idxs,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,a_err='psb_cd_get_list') + goto 9999 + end if + + call psi_swaptran(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) + if (info /= psb_success_) 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(ictxt) + return + end if + return +end subroutine psi_zswaptran_vect + + + +subroutine psi_ztranidx_vect(ictxt,icomm,flag,beta,y,idx,& + & totxch,totsnd,totrcv,work,info) + + use psi_mod, psb_protect_name => psi_ztranidx_vect + use psb_error_mod + use psb_descriptor_type + use psb_penv_mod + use psb_z_base_vect_mod +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif + + integer, intent(in) :: ictxt,icomm,flag + integer, intent(out) :: info + class(psb_z_base_vect_type) :: y + complex(psb_dpk_) :: beta + complex(psb_dpk_), target :: work(:) + integer, intent(in) :: idx(:),totxch,totsnd, totrcv + + ! locals + integer :: np, me, nesd, nerv,& + & proc_to_comm, p2ptag, p2pstat(mpi_status_size),& + & iret, err_act, i, idx_pt, totsnd_, totrcv_,& + & snd_pt, rcv_pt, pnti, data_, n + integer, allocatable, dimension(:) :: bsdidx, brvidx,& + & sdsz, rvsz, prcid, rvhd, sdhd + integer :: int_err(5) + logical :: swap_mpi, swap_sync, swap_send, swap_recv,& + & albf,do_send,do_recv + logical, parameter :: usersend=.false. + + complex(psb_dpk_), pointer, dimension(:) :: sndbuf, rcvbuf +#ifdef HAVE_VOLATILE + volatile :: sndbuf, rcvbuf +#endif + character(len=20) :: name + + info=psb_success_ + name='psi_swap_tran' + call psb_erractionsave(err_act) + + call psb_info(ictxt,me,np) + if (np == -1) then + info=psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + n=1 + swap_mpi = iand(flag,psb_swap_mpi_) /= 0 + swap_sync = iand(flag,psb_swap_sync_) /= 0 + swap_send = iand(flag,psb_swap_send_) /= 0 + swap_recv = iand(flag,psb_swap_recv_) /= 0 + do_send = swap_mpi .or. swap_sync .or. swap_send + do_recv = swap_mpi .or. swap_sync .or. swap_recv + + totrcv_ = totrcv * n + totsnd_ = totsnd * n + + if (swap_mpi) then + allocate(sdsz(0:np-1), rvsz(0:np-1), bsdidx(0:np-1),& + & brvidx(0:np-1), rvhd(0:np-1), sdhd(0:np-1), prcid(0:np-1),& + & stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + + rvhd(:) = mpi_request_null + sdsz(:) = 0 + rvsz(:) = 0 + + ! prepare info for communications + + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + call psb_get_rank(prcid(proc_to_comm),ictxt,proc_to_comm) + + brvidx(proc_to_comm) = rcv_pt + rvsz(proc_to_comm) = nerv + + bsdidx(proc_to_comm) = snd_pt + sdsz(proc_to_comm) = nesd + + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + + end do + + else + allocate(rvhd(totxch),prcid(totxch),stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + end if + + + totrcv_ = max(totrcv_,1) + totsnd_ = max(totsnd_,1) + if((totrcv_+totsnd_) < size(work)) then + sndbuf => work(1:totsnd_) + rcvbuf => work(totsnd_+1:totsnd_+totrcv_) + albf=.false. + else + allocate(sndbuf(totsnd_),rcvbuf(totrcv_), stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + albf=.true. + end if + + + if (do_send) then + + ! Pack send buffers + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + idx_pt = 1+pnti+psb_n_elem_recv_ + + call y%gth(nerv,idx(idx_pt:idx_pt+nerv-1),& + & rcvbuf(rcv_pt:rcv_pt+nerv-1)) + + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + end if + + ! Case SWAP_MPI + if (swap_mpi) then + + ! swap elements using mpi_alltoallv + call mpi_alltoallv(rcvbuf,rvsz,brvidx,& + & mpi_double_complex,& + & sndbuf,sdsz,bsdidx,mpi_double_complex,icomm,iret) + if(iret /= mpi_success) then + int_err(1) = iret + info=psb_err_mpi_error_ + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + else if (swap_sync) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + + if (proc_to_comm < me) then + if (nerv>0) call psb_snd(ictxt,& + & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) + if (nesd>0) call psb_rcv(ictxt,& + & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) + else if (proc_to_comm > me) then + if (nesd>0) call psb_rcv(ictxt,& + & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) + if (nerv>0) call psb_snd(ictxt,& + & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) + else if (proc_to_comm == me) then + if (nesd /= nerv) then + write(psb_err_unit,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd + end if + sndbuf(snd_pt:snd_pt+nesd-1) = rcvbuf(rcv_pt:rcv_pt+nerv-1) + end if + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + + end do + + + else if (swap_send .and. swap_recv) then + + ! First I post all the non blocking receives + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + call psb_get_rank(prcid(i),ictxt,proc_to_comm) + if ((nesd>0).and.(proc_to_comm /= me)) then + p2ptag = psb_dcomplex_swap_tag + call mpi_irecv(sndbuf(snd_pt),nesd,& + & mpi_double_complex,prcid(i),& + & p2ptag,icomm,rvhd(i),iret) + end if + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + + ! Then I post all the blocking sends + if (usersend) call mpi_barrier(icomm,info) + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + + if ((nerv>0).and.(proc_to_comm /= me)) then + p2ptag=psb_dcomplex_swap_tag + if (usersend) then + call mpi_rsend(rcvbuf(rcv_pt),nerv,& + & mpi_double_complex,prcid(i),& + & p2ptag, icomm,iret) + else + call mpi_send(rcvbuf(rcv_pt),nerv,& + & mpi_double_complex,prcid(i),& + & p2ptag, icomm,iret) + end if + + if(iret /= mpi_success) then + int_err(1) = iret + info=psb_err_mpi_error_ + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + end if + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + + end do + + + pnti = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + p2ptag = psb_dcomplex_swap_tag + + if ((proc_to_comm /= me).and.(nesd>0)) then + call mpi_wait(rvhd(i),p2pstat,iret) + if(iret /= mpi_success) then + int_err(1) = iret + info=psb_err_mpi_error_ + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + else if (proc_to_comm == me) then + if (nesd /= nerv) then + write(psb_err_unit,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd + end if + sndbuf(snd_pt:snd_pt+nesd-1) = rcvbuf(rcv_pt:rcv_pt+nerv-1) + end if + pnti = pnti + nerv + nesd + 3 + end do + + + else if (swap_send) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + if (nerv>0) call psb_snd(ictxt,& + & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + + end do + + else if (swap_recv) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + if (nesd>0) call psb_rcv(ictxt,& + & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + + end do + + end if + + + if (do_recv) then + + pnti = 1 + snd_pt = 1 + rcv_pt = 1 + do i=1, totxch + proc_to_comm = idx(pnti+psb_proc_id_) + nerv = idx(pnti+psb_n_elem_recv_) + nesd = idx(pnti+nerv+psb_n_elem_send_) + idx_pt = 1+pnti+nerv+psb_n_elem_send_ + call y%sct(nesd,idx(idx_pt:idx_pt+nesd-1),& + & sndbuf(snd_pt:snd_pt+nesd-1),beta) + rcv_pt = rcv_pt + nerv + snd_pt = snd_pt + nesd + pnti = pnti + nerv + nesd + 3 + end do + + end if + + + if (swap_mpi) then + deallocate(sdsz,rvsz,bsdidx,brvidx,rvhd,prcid,sdhd,& + & stat=info) + else + deallocate(rvhd,prcid,stat=info) + end if + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,name) + goto 9999 + end if + if(albf) deallocate(sndbuf,rcvbuf,stat=info) + if(info /= psb_success_) then + call psb_errpush(psb_err_alloc_dealloc_,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(ictxt) + return + end if + return +end subroutine psi_ztranidx_vect + + + diff --git a/base/modules/Makefile b/base/modules/Makefile index 91c81ff24..c5e183fdd 100644 --- a/base/modules/Makefile +++ b/base/modules/Makefile @@ -11,10 +11,18 @@ UTIL_MODS = psb_string_mod.o psb_desc_const_mod.o psb_indx_map_mod.o\ psi_reduce_mod.o psi_p2p_mod.o psb_error_impl.o \ psb_linmap_type_mod.o psb_linmap_mod.o \ psb_s_linmap_mod.o psb_d_linmap_mod.o psb_c_linmap_mod.o psb_z_linmap_mod.o \ - psb_comm_mod.o\ + psb_comm_mod.o psb_i_comm_mod.o psb_s_comm_mod.o psb_d_comm_mod.o\ + psb_c_comm_mod.o psb_z_comm_mod.o \ + psb_d_base_vect_mod.o psb_d_vect_mod.o\ + psb_s_base_vect_mod.o psb_s_vect_mod.o\ + psb_c_base_vect_mod.o psb_c_vect_mod.o\ + psb_z_base_vect_mod.o psb_z_vect_mod.o\ + psb_vect_mod.o\ psb_s_psblas_mod.o psb_c_psblas_mod.o \ psb_d_psblas_mod.o psb_z_psblas_mod.o psb_psblas_mod.o \ - psi_serial_mod.o psi_mod.o psb_ip_reord_mod.o\ + psi_serial_mod.o \ + psi_mod.o psi_i_mod.o psi_s_mod.o psi_d_mod.o psi_c_mod.o psi_z_mod.o\ + psb_ip_reord_mod.o\ psb_check_mod.o psb_hash_mod.o\ psb_base_mat_mod.o psb_mat_mod.o\ psb_s_base_mat_mod.o psb_s_csr_mat_mod.o psb_s_csc_mat_mod.o psb_s_mat_mod.o \ @@ -40,59 +48,89 @@ $(LIBDIR)/$(LIBNAME): $(MODULES) $(OBJS) $(MPFOBJS) $(AR) $(LIBDIR)/$(LIBNAME) $(MODULES) $(OBJS) $(MPFOBJS) $(RANLIB) $(LIBDIR)/$(LIBNAME) -psi_comm_buffers_mod.o: psb_const_mod.o -psi_penv_mod.o: psi_comm_buffers_mod.o psb_const_mod.o psb_realloc_mod.o + +psb_error_mod.o: psb_const_mod.o +psb_realloc_mod.o: psb_error_mod.o +$(UTILS_MODS): $(BASIC_MODS) + + +psi_penv_mod.o: psi_comm_buffers_mod.o psi_bcast_mod.o psi_reduce_mod.o psi_p2p_mod.o: psi_penv_mod.o psb_penv_mod.o: psi_bcast_mod.o psi_reduce_mod.o psi_p2p_mod.o -psb_base_mat_mod.o: psb_const_mod.o psi_serial_mod.o +psb_base_mat_mod.o: psi_serial_mod.o psb_s_base_mat_mod.o psb_d_base_mat_mod.o psb_c_base_mat_mod.o psb_z_base_mat_mod.o: psb_base_mat_mod.o -psb_s_mat_mod.o: psb_s_base_mat_mod.o psb_s_csr_mat_mod.o psb_s_csc_mat_mod.o -psb_d_mat_mod.o: psb_d_base_mat_mod.o psb_d_csr_mat_mod.o psb_d_csc_mat_mod.o -psb_c_mat_mod.o: psb_c_base_mat_mod.o psb_c_csr_mat_mod.o psb_c_csc_mat_mod.o -psb_z_mat_mod.o: psb_z_base_mat_mod.o psb_z_csr_mat_mod.o psb_z_csc_mat_mod.o +psb_s_base_mat_mod.o: psb_s_base_vect_mod.o +psb_d_base_mat_mod.o: psb_d_base_vect_mod.o +psb_c_base_mat_mod.o: psb_c_base_vect_mod.o +psb_z_base_mat_mod.o: psb_z_base_vect_mod.o +psb_c_base_vect_mod.o psb_s_base_vect_mod.o psb_d_base_vect_mod.o psb_z_base_vect_mod.o: psi_serial_mod.o +psb_s_mat_mod.o: psb_s_base_mat_mod.o psb_s_csr_mat_mod.o psb_s_csc_mat_mod.o psb_s_vect_mod.o +psb_d_mat_mod.o: psb_d_base_mat_mod.o psb_d_csr_mat_mod.o psb_d_csc_mat_mod.o psb_d_vect_mod.o +psb_c_mat_mod.o: psb_c_base_mat_mod.o psb_c_csr_mat_mod.o psb_c_csc_mat_mod.o psb_c_vect_mod.o +psb_z_mat_mod.o: psb_z_base_mat_mod.o psb_z_csr_mat_mod.o psb_z_csc_mat_mod.o psb_z_vect_mod.o psb_s_csc_mat_mod.o psb_s_csr_mat_mod.o: psb_s_base_mat_mod.o psb_d_csc_mat_mod.o psb_d_csr_mat_mod.o: psb_d_base_mat_mod.o psb_c_csc_mat_mod.o psb_c_csr_mat_mod.o: psb_c_base_mat_mod.o psb_z_csc_mat_mod.o psb_z_csr_mat_mod.o: psb_z_base_mat_mod.o -psb_mat_mod.o: psb_s_mat_mod.o psb_d_mat_mod.o psb_c_mat_mod.o psb_z_mat_mod.o +psb_mat_mod.o: psb_vect_mod.o psb_s_mat_mod.o psb_d_mat_mod.o psb_c_mat_mod.o psb_z_mat_mod.o error.o psb_realloc_mod.o : psb_error_mod.o -psb_error_impl.o : psb_error_mod.o psb_penv_mod.o -psb_spmat_type.o : psb_realloc_mod.o psb_error_mod.o psb_const_mod.o psb_string_mod.o psb_sort_mod.o -psb_error_mod.o: psb_const_mod.o -psb_ip_reord_mod.o: psb_const_mod.o -psb_blacs_mod.o: psb_const_mod.o -psi_serial_mod.o: psb_const_mod.o psb_realloc_mod.o -psi_mod.o: psb_penv_mod.o psb_error_mod.o psb_desc_type.o psb_const_mod.o psi_serial_mod.o psb_serial_mod.o -psb_desc_type.o: psb_const_mod.o psb_error_mod.o psb_penv_mod.o psb_realloc_mod.o\ +psb_error_impl.o: psb_penv_mod.o +psb_spmat_type.o: psb_string_mod.o psb_sort_mod.o +psi_i_mod.o: psb_desc_type.o +psi_s_mod.o: psb_desc_type.o psb_s_base_vect_mod.o +psi_d_mod.o: psb_desc_type.o psb_d_base_vect_mod.o +psi_c_mod.o: psb_desc_type.o psb_c_base_vect_mod.o +psi_z_mod.o: psb_desc_type.o psb_z_base_vect_mod.o +psi_mod.o: psb_penv_mod.o psb_desc_type.o psi_serial_mod.o psb_serial_mod.o\ + psi_i_mod.o psi_s_mod.o psi_d_mod.o psi_c_mod.o psi_z_mod.o +psb_desc_type.o: psb_penv_mod.o psb_realloc_mod.o\ psb_hash_mod.o psb_hash_map_mod.o psb_list_map_mod.o \ psb_repl_map_mod.o psb_gen_block_map_mod.o psb_desc_const_mod.o\ psb_indx_map_mod.o -psb_indx_map_mod.o: psb_desc_const_mod.o psb_const_mod.o +psb_indx_map_mod.o: psb_desc_const_mod.o psb_hash_map_mod.o psb_list_map_mod.o psb_repl_map_mod.o psb_gen_block_map_mod.o:\ - psb_indx_map_mod.o \ - psb_desc_const_mod.o psb_const_mod.o psb_realloc_mod.o \ - psb_sort_mod.o psb_penv_mod.o psb_error_mod.o + psb_indx_map_mod.o psb_desc_const_mod.o \ + psb_sort_mod.o psb_penv_mod.o psb_glist_map_mod.o: psb_list_map_mod.o psb_hash_map_mod.o: psb_hash_mod.o psb_sort_mod.o psb_linmap_mod.o: psb_s_linmap_mod.o psb_d_linmap_mod.o psb_c_linmap_mod.o psb_z_linmap_mod.o -psb_s_linmap_mod.o psb_d_linmap_mod.o psb_c_linmap_mod.o psb_z_linmap_mod.o: psb_linmap_type_mod.o psb_mat_mod.o -psb_linmap_type_mod.o: psb_desc_type.o psb_error_mod.o psb_serial_mod.o psb_comm_mod.o psb_mat_mod.o -psb_comm_mod.o: psb_desc_type.o psb_mat_mod.o +psb_s_linmap_mod.o: psb_linmap_type_mod.o psb_mat_mod.o psb_s_vect_mod.o +psb_d_linmap_mod.o: psb_linmap_type_mod.o psb_mat_mod.o psb_d_vect_mod.o +psb_c_linmap_mod.o: psb_linmap_type_mod.o psb_mat_mod.o psb_c_vect_mod.o +psb_z_linmap_mod.o: psb_linmap_type_mod.o psb_mat_mod.o psb_z_vect_mod.o +psb_linmap_type_mod.o: psb_desc_type.o psb_serial_mod.o psb_comm_mod.o psb_mat_mod.o +psb_comm_mod.o: psb_desc_type.o psb_mat_mod.o psb_check_mod.o: psb_desc_type.o psb_serial_mod.o: psb_mat_mod.o psb_string_mod.o psb_sort_mod.o psi_serial_mod.o -psb_sort_mod.o: psb_error_mod.o psb_realloc_mod.o psb_const_mod.o -psb_tools_mod.o: psb_base_tools_mod.o psb_s_tools_mod.o psb_d_tools_mod.o\ +psb_s_vect_mod.o: psb_s_base_vect_mod.o +psb_d_vect_mod.o: psb_d_base_vect_mod.o +psb_c_vect_mod.o: psb_c_base_vect_mod.o +psb_z_vect_mod.o: psb_z_base_vect_mod.o +psb_tools_mod.o: psb_base_tools_mod.o psb_s_tools_mod.o psb_d_tools_mod.o\ psb_c_tools_mod.o psb_z_tools_mod.o psb_base_tools_mod.o psb_s_tools_mod.o psb_d_tools_mod.o psb_c_tools_mod.o psb_z_tools_mod.o: psb_desc_type.o psi_mod.o psb_mat_mod.o +psb_s_tools_mod.o: psb_s_vect_mod.o +psb_d_tools_mod.o: psb_d_vect_mod.o +psb_c_tools_mod.o: psb_c_vect_mod.o +psb_z_tools_mod.o: psb_z_vect_mod.o + +psb_s_psblas_mod.o: psb_s_vect_mod.o psb_s_mat_mod.o +psb_d_psblas_mod.o: psb_d_vect_mod.o psb_d_mat_mod.o +psb_c_psblas_mod.o: psb_c_vect_mod.o psb_c_mat_mod.o +psb_z_psblas_mod.o: psb_z_vect_mod.o psb_z_mat_mod.o psb_psblas_mod.o: psb_s_psblas_mod.o psb_c_psblas_mod.o psb_d_psblas_mod.o psb_z_psblas_mod.o psb_s_psblas_mod.o psb_c_psblas_mod.o psb_d_psblas_mod.o psb_z_psblas_mod.o: psb_mat_mod.o psb_desc_type.o - -psb_hash_mod.o: psb_const_mod.o psb_realloc_mod.o +psb_vect_mod.o: psb_d_vect_mod.o psb_s_vect_mod.o psb_c_vect_mod.o psb_z_vect_mod.o +psb_comm_mod.o: psb_i_comm_mod.o psb_s_comm_mod.o psb_d_comm_mod.o psb_c_comm_mod.o psb_z_comm_mod.o +psb_i_comm_mod.o: psb_desc_type.o +psb_s_comm_mod.o: psb_s_vect_mod.o psb_desc_type.o psb_mat_mod.o +psb_d_comm_mod.o: psb_d_vect_mod.o psb_desc_type.o psb_mat_mod.o +psb_c_comm_mod.o: psb_c_vect_mod.o psb_desc_type.o psb_mat_mod.o +psb_z_comm_mod.o: psb_z_vect_mod.o psb_desc_type.o psb_mat_mod.o psb_base_mod.o: $(MODULES) - penvmod: $(BASIC_MODS) ($(MAKE) psb_penv_mod.o F90COPT="$(F90COPT) $(EXTRA_OPT)") diff --git a/base/modules/psb_base_mat_mod.f90 b/base/modules/psb_base_mat_mod.f90 index ff93bd931..574575d2a 100644 --- a/base/modules/psb_base_mat_mod.f90 +++ b/base/modules/psb_base_mat_mod.f90 @@ -307,7 +307,7 @@ contains class(psb_base_sparse_mat), intent(inout) :: a integer, intent(in) :: v(:) ! TBD - write(psb_err_unit,*) 'SET_AUX is empty right now ' + !write(psb_err_unit,*) 'SET_AUX is empty right now ' end subroutine psb_base_set_aux subroutine psb_base_get_aux(v,a) @@ -315,7 +315,7 @@ contains class(psb_base_sparse_mat), intent(in) :: a integer, intent(out), allocatable :: v(:) ! TBD - write(psb_err_unit,*) 'GET_AUX is empty right now ' + !write(psb_err_unit,*) 'GET_AUX is empty right now ' end subroutine psb_base_get_aux subroutine psb_base_set_nrows(m,a) diff --git a/base/modules/psb_base_mod.f90 b/base/modules/psb_base_mod.f90 index 3b30d8c93..51dc45e09 100644 --- a/base/modules/psb_base_mod.f90 +++ b/base/modules/psb_base_mod.f90 @@ -36,6 +36,7 @@ module psb_base_mod use psb_check_mod use psb_descriptor_type use psb_linmap_mod + use psb_vect_mod use psb_mat_mod use psb_serial_mod use psb_comm_mod diff --git a/base/modules/psb_c_base_mat_mod.f90 b/base/modules/psb_c_base_mat_mod.f90 index 0bbc2fad0..84e9e5118 100644 --- a/base/modules/psb_c_base_mat_mod.f90 +++ b/base/modules/psb_c_base_mat_mod.f90 @@ -57,22 +57,32 @@ module psb_c_base_mat_mod use psb_base_mat_mod + use psb_c_base_vect_mod type, extends(psb_base_sparse_mat) :: psb_c_base_sparse_mat contains + procedure, pass(a) :: c_sp_mv => psb_c_base_vect_mv procedure, pass(a) :: c_csmv => psb_c_base_csmv procedure, pass(a) :: c_csmm => psb_c_base_csmm - generic, public :: csmm => c_csmm, c_csmv + generic, public :: csmm => c_csmm, c_csmv, c_sp_mv + procedure, pass(a) :: c_in_sv => psb_c_base_inner_vect_sv procedure, pass(a) :: c_inner_cssv => psb_c_base_inner_cssv procedure, pass(a) :: c_inner_cssm => psb_c_base_inner_cssm - generic, public :: inner_cssm => c_inner_cssm, c_inner_cssv + generic, public :: inner_cssm => c_inner_cssm, c_inner_cssv, c_in_sv + procedure, pass(a) :: c_vect_cssv => psb_c_base_vect_cssv procedure, pass(a) :: c_cssv => psb_c_base_cssv procedure, pass(a) :: c_cssm => psb_c_base_cssm - generic, public :: cssm => c_cssm, c_cssv + generic, public :: cssm => c_cssm, c_cssv, c_vect_cssv procedure, pass(a) :: c_scals => psb_c_base_scals procedure, pass(a) :: c_scal => psb_c_base_scal generic, public :: scal => c_scals, c_scal + procedure, pass(a) :: maxval => psb_c_base_maxval procedure, pass(a) :: csnmi => psb_c_base_csnmi + procedure, pass(a) :: csnm1 => psb_c_base_csnm1 + procedure, pass(a) :: rowsum => psb_c_base_rowsum + procedure, pass(a) :: arwsum => psb_c_base_arwsum + procedure, pass(a) :: colsum => psb_c_base_colsum + procedure, pass(a) :: aclsum => psb_c_base_aclsum procedure, pass(a) :: get_diag => psb_c_base_get_diag procedure, pass(a) :: csput => psb_c_base_csput @@ -123,7 +133,13 @@ module psb_c_base_mat_mod procedure, pass(a) :: c_inner_cssv => psb_c_coo_cssv procedure, pass(a) :: c_scals => psb_c_coo_scals procedure, pass(a) :: c_scal => psb_c_coo_scal + procedure, pass(a) :: maxval => psb_c_coo_maxval procedure, pass(a) :: csnmi => psb_c_coo_csnmi + procedure, pass(a) :: csnm1 => psb_c_coo_csnm1 + procedure, pass(a) :: rowsum => psb_c_coo_rowsum + procedure, pass(a) :: arwsum => psb_c_coo_arwsum + procedure, pass(a) :: colsum => psb_c_coo_colsum + procedure, pass(a) :: aclsum => psb_c_coo_aclsum procedure, pass(a) :: reallocate_nz => psb_c_coo_reallocate_nz procedure, pass(a) :: allocate_mnnz => psb_c_coo_allocate_mnnz procedure, pass(a) :: cp_to_coo => psb_c_cp_coo_to_coo @@ -189,6 +205,18 @@ module psb_c_base_mat_mod end subroutine psb_c_base_csmv end interface + interface + subroutine psb_c_base_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_c_base_sparse_mat, psb_spk_, psb_c_base_vect_type + class(psb_c_base_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta + class(psb_c_base_vect_type), intent(inout) :: x + class(psb_c_base_vect_type), intent(inout) :: y + integer, intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_c_base_vect_mv + end interface + interface subroutine psb_c_base_inner_cssm(alpha,a,x,beta,y,info,trans) import :: psb_c_base_sparse_mat, psb_spk_ @@ -211,6 +239,17 @@ module psb_c_base_mat_mod end subroutine psb_c_base_inner_cssv end interface + interface + subroutine psb_c_base_inner_vect_sv(alpha,a,x,beta,y,info,trans) + import :: psb_c_base_sparse_mat, psb_spk_, psb_c_base_vect_type + class(psb_c_base_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta + class(psb_c_base_vect_type), intent(inout) :: x, y + integer, intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_c_base_inner_vect_sv + end interface + interface subroutine psb_c_base_cssm(alpha,a,x,beta,y,info,trans,scale,d) import :: psb_c_base_sparse_mat, psb_spk_ @@ -235,6 +274,18 @@ module psb_c_base_mat_mod end subroutine psb_c_base_cssv end interface + interface + subroutine psb_c_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d) + import :: psb_c_base_sparse_mat, psb_spk_,psb_c_base_vect_type + class(psb_c_base_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta + class(psb_c_base_vect_type), intent(inout) :: x,y + integer, intent(out) :: info + character, optional, intent(in) :: trans, scale + class(psb_c_base_vect_type), optional, intent(inout) :: d + end subroutine psb_c_base_vect_cssv + end interface + interface subroutine psb_c_base_scals(d,a,info) import :: psb_c_base_sparse_mat, psb_spk_ @@ -252,6 +303,15 @@ module psb_c_base_mat_mod integer, intent(out) :: info end subroutine psb_c_base_scal end interface + + + interface + function psb_c_base_maxval(a) result(res) + import :: psb_c_base_sparse_mat, psb_spk_ + class(psb_c_base_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + end function psb_c_base_maxval + end interface interface function psb_c_base_csnmi(a) result(res) @@ -261,6 +321,46 @@ module psb_c_base_mat_mod end function psb_c_base_csnmi end interface + interface + function psb_c_base_csnm1(a) result(res) + import :: psb_c_base_sparse_mat, psb_spk_ + class(psb_c_base_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + end function psb_c_base_csnm1 + end interface + + interface + subroutine psb_c_base_rowsum(d,a) + import :: psb_c_base_sparse_mat, psb_spk_ + class(psb_c_base_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(out) :: d(:) + end subroutine psb_c_base_rowsum + end interface + + interface + subroutine psb_c_base_arwsum(d,a) + import :: psb_c_base_sparse_mat, psb_spk_ + class(psb_c_base_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_c_base_arwsum + end interface + + interface + subroutine psb_c_base_colsum(d,a) + import :: psb_c_base_sparse_mat, psb_spk_ + class(psb_c_base_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(out) :: d(:) + end subroutine psb_c_base_colsum + end interface + + interface + subroutine psb_c_base_aclsum(d,a) + import :: psb_c_base_sparse_mat, psb_spk_ + class(psb_c_base_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_c_base_aclsum + end interface + interface subroutine psb_c_base_get_diag(a,d,info) import :: psb_c_base_sparse_mat, psb_spk_ @@ -702,7 +802,14 @@ module psb_c_base_mat_mod end subroutine psb_c_coo_csmm end interface - + interface + function psb_c_coo_maxval(a) result(res) + import :: psb_c_coo_sparse_mat, psb_spk_ + class(psb_c_coo_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + end function psb_c_coo_maxval + end interface + interface function psb_c_coo_csnmi(a) result(res) import :: psb_c_coo_sparse_mat, psb_spk_ @@ -711,6 +818,46 @@ module psb_c_base_mat_mod end function psb_c_coo_csnmi end interface + interface + function psb_c_coo_csnm1(a) result(res) + import :: psb_c_coo_sparse_mat, psb_spk_ + class(psb_c_coo_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + end function psb_c_coo_csnm1 + end interface + + interface + subroutine psb_c_coo_rowsum(d,a) + import :: psb_c_coo_sparse_mat, psb_spk_ + class(psb_c_coo_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(out) :: d(:) + end subroutine psb_c_coo_rowsum + end interface + + interface + subroutine psb_c_coo_arwsum(d,a) + import :: psb_c_coo_sparse_mat, psb_spk_ + class(psb_c_coo_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_c_coo_arwsum + end interface + + interface + subroutine psb_c_coo_colsum(d,a) + import :: psb_c_coo_sparse_mat, psb_spk_ + class(psb_c_coo_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(out) :: d(:) + end subroutine psb_c_coo_colsum + end interface + + interface + subroutine psb_c_coo_aclsum(d,a) + import :: psb_c_coo_sparse_mat, psb_spk_ + class(psb_c_coo_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_c_coo_aclsum + end interface + interface subroutine psb_c_coo_get_diag(a,d,info) import :: psb_c_coo_sparse_mat, psb_spk_ diff --git a/base/modules/psb_c_base_vect_mod.f90 b/base/modules/psb_c_base_vect_mod.f90 new file mode 100644 index 000000000..b0c1f755a --- /dev/null +++ b/base/modules/psb_c_base_vect_mod.f90 @@ -0,0 +1,580 @@ +module psb_c_base_vect_mod + + use psb_const_mod + use psb_error_mod + + type psb_c_base_vect_type + complex(psb_spk_), allocatable :: v(:) + contains + procedure, pass(x) :: get_nrows => c_base_get_nrows + procedure, pass(x) :: dot_v => c_base_dot_v + procedure, pass(x) :: dot_a => c_base_dot_a + generic, public :: dot => dot_v, dot_a + procedure, pass(y) :: axpby_v => c_base_axpby_v + procedure, pass(y) :: axpby_a => c_base_axpby_a + generic, public :: axpby => axpby_v, axpby_a + procedure, pass(y) :: mlt_v => c_base_mlt_v + procedure, pass(y) :: mlt_a => c_base_mlt_a + procedure, pass(z) :: mlt_a_2 => c_base_mlt_a_2 + procedure, pass(z) :: mlt_v_2 => c_base_mlt_v_2 + procedure, pass(z) :: mlt_va => c_base_mlt_va + procedure, pass(z) :: mlt_av => c_base_mlt_av + generic, public :: mlt => mlt_v, mlt_a, mlt_a_2, mlt_v_2, mlt_av, mlt_va + procedure, pass(x) :: scal => c_base_scal + procedure, pass(x) :: nrm2 => c_base_nrm2 + procedure, pass(x) :: amax => c_base_amax + procedure, pass(x) :: asum => c_base_asum + procedure, pass(x) :: all => c_base_all + procedure, pass(x) :: zero => c_base_zero + procedure, pass(x) :: asb => c_base_asb + procedure, pass(x) :: sync => c_base_sync + procedure, pass(x) :: gthab => c_base_gthab + procedure, pass(x) :: gthzv => c_base_gthzv + generic, public :: gth => gthab, gthzv + procedure, pass(y) :: sctb => c_base_sctb + generic, public :: sct => sctb + procedure, pass(x) :: free => c_base_free + procedure, pass(x) :: ins => c_base_ins + procedure, pass(x) :: bld_x => c_base_bld_x + procedure, pass(x) :: bld_n => c_base_bld_n + generic, public :: bld => bld_x, bld_n + procedure, pass(x) :: getCopy => c_base_getCopy + procedure, pass(x) :: cpy_vect => c_base_cpy_vect + generic, public :: assignment(=) => cpy_vect, set_scal + procedure, pass(x) :: set_scal => c_base_set_scal + procedure, pass(x) :: set_vect => c_base_set_vect + generic, public :: set => set_vect, set_scal + end type psb_c_base_vect_type + + public :: psb_c_base_vect + private :: constructor, size_const + interface psb_c_base_vect + module procedure constructor, size_const + end interface psb_c_base_vect + +contains + + subroutine c_base_bld_x(x,this) + use psb_realloc_mod + complex(psb_spk_), intent(in) :: this(:) + class(psb_c_base_vect_type), intent(inout) :: x + integer :: info + + call psb_realloc(size(this),x%v,info) + if (info /= 0) then + call psb_errpush(psb_err_alloc_dealloc_,'base_vect_bld') + return + end if + x%v(:) = this(:) + + end subroutine c_base_bld_x + + + subroutine c_base_bld_n(x,n) + integer, intent(in) :: n + class(psb_c_base_vect_type), intent(inout) :: x + integer :: info + + call x%asb(n,info) + + end subroutine c_base_bld_n + + function c_base_getCopy(x) result(res) + class(psb_c_base_vect_type), intent(in) :: x + complex(psb_spk_), allocatable :: res(:) + integer :: info + + allocate(res(x%get_nrows()),stat=info) + if (info /= 0) then + call psb_errpush(psb_err_alloc_dealloc_,'base_getCopy') + return + end if + res(:) = x%v(:) + end function c_base_getCopy + + subroutine c_base_cpy_vect(res,x) + complex(psb_spk_), allocatable, intent(out) :: res(:) + class(psb_c_base_vect_type), intent(in) :: x + integer :: info + + res = x%v + + end subroutine c_base_cpy_vect + + subroutine c_base_set_scal(x,val) + class(psb_c_base_vect_type), intent(inout) :: x + complex(psb_spk_), intent(in) :: val + + integer :: info + x%v = val + + end subroutine c_base_set_scal + + subroutine c_base_set_vect(x,val) + class(psb_c_base_vect_type), intent(inout) :: x + complex(psb_spk_), intent(in) :: val(:) + + integer :: info + x%v = val + + end subroutine c_base_set_vect + + + function constructor(x) result(this) + complex(psb_spk_) :: x(:) + type(psb_c_base_vect_type) :: this + integer :: info + + this%v = x + call this%asb(size(x),info) + end function constructor + + + function size_const(n) result(this) + integer, intent(in) :: n + type(psb_c_base_vect_type) :: this + integer :: info + + call this%asb(n,info) + + end function size_const + + + function c_base_get_nrows(x) result(res) + implicit none + class(psb_c_base_vect_type), intent(in) :: x + integer :: res + res = -1 + if (allocated(x%v)) res = size(x%v) + end function c_base_get_nrows + + function c_base_dot_v(n,x,y) result(res) + implicit none + class(psb_c_base_vect_type), intent(inout) :: x, y + integer, intent(in) :: n + complex(psb_spk_) :: res + complex(psb_spk_), external :: cdotc + + res = czero + ! + ! Note: this is the base implementation. + ! When we get here, we are sure that X is of + ! TYPE psb_c_base_vect + ! + select type(yy => y) + type is (psb_c_base_vect_type) + res = cdotc(n,x%v,1,y%v,1) + class default + res = y%dot(n,x%v) + end select + + end function c_base_dot_v + + function c_base_dot_a(n,x,y) result(res) + implicit none + class(psb_c_base_vect_type), intent(inout) :: x + complex(psb_spk_), intent(in) :: y(:) + integer, intent(in) :: n + complex(psb_spk_) :: res + complex(psb_spk_), external :: cdotc + + res = cdotc(n,y,1,x%v,1) + + end function c_base_dot_a + + subroutine c_base_axpby_v(m,alpha, x, beta, y, info) + use psi_serial_mod + implicit none + integer, intent(in) :: m + class(psb_c_base_vect_type), intent(inout) :: x + class(psb_c_base_vect_type), intent(inout) :: y + complex(psb_spk_), intent (in) :: alpha, beta + integer, intent(out) :: info + + select type(xx => x) + type is (psb_c_base_vect_type) + call psb_geaxpby(m,alpha,x%v,beta,y%v,info) + class default + call y%axpby(m,alpha,x%v,beta,info) + end select + + end subroutine c_base_axpby_v + + subroutine c_base_axpby_a(m,alpha, x, beta, y, info) + use psi_serial_mod + implicit none + integer, intent(in) :: m + complex(psb_spk_), intent(in) :: x(:) + class(psb_c_base_vect_type), intent(inout) :: y + complex(psb_spk_), intent (in) :: alpha, beta + integer, intent(out) :: info + + call psb_geaxpby(m,alpha,x,beta,y%v,info) + + end subroutine c_base_axpby_a + + + subroutine c_base_mlt_v(x, y, info) + use psi_serial_mod + implicit none + class(psb_c_base_vect_type), intent(inout) :: x + class(psb_c_base_vect_type), intent(inout) :: y + integer, intent(out) :: info + integer :: i, n + + info = 0 + select type(xx => x) + type is (psb_c_base_vect_type) + n = min(size(y%v), size(xx%v)) + do i=1, n + y%v(i) = y%v(i)*xx%v(i) + end do + class default + call y%mlt(x%v,info) + end select + + end subroutine c_base_mlt_v + + subroutine c_base_mlt_a(x, y, info) + use psi_serial_mod + implicit none + complex(psb_spk_), intent(in) :: x(:) + class(psb_c_base_vect_type), intent(inout) :: y + integer, intent(out) :: info + integer :: i, n + + info = 0 + n = min(size(y%v), size(x)) + do i=1, n + y%v(i) = y%v(i)*x(i) + end do + + end subroutine c_base_mlt_a + + + subroutine c_base_mlt_a_2(alpha,x,y,beta,z,info) + use psi_serial_mod + implicit none + complex(psb_spk_), intent(in) :: alpha,beta + complex(psb_spk_), intent(in) :: y(:) + complex(psb_spk_), intent(in) :: x(:) + class(psb_c_base_vect_type), intent(inout) :: z + integer, intent(out) :: info +! character(len=1), intent(in), optional :: conjgx, conjgy + + integer :: i, n + + info = 0 + n = min(size(z%v), size(x), size(y)) +!!$ write(0,*) 'Mlt_a_2: ',n + if (alpha == czero) then + if (beta == cone) then + return + else + do i=1, n + z%v(i) = beta*z%v(i) + end do + end if + else + if (alpha == cone) then + if (beta == czero) then + do i=1, n + z%v(i) = y(i)*x(i) + end do + else if (beta == cone) then + do i=1, n + z%v(i) = z%v(i) + y(i)*x(i) + end do + else + do i=1, n + z%v(i) = beta*z%v(i) + y(i)*x(i) + end do + end if + else if (alpha == -cone) then + if (beta == czero) then + do i=1, n + z%v(i) = -y(i)*x(i) + end do + else if (beta == cone) then + do i=1, n + z%v(i) = z%v(i) - y(i)*x(i) + end do + else + do i=1, n + z%v(i) = beta*z%v(i) - y(i)*x(i) + end do + end if + else + if (beta == czero) then + do i=1, n + z%v(i) = alpha*y(i)*x(i) + end do + else if (beta == cone) then + do i=1, n + z%v(i) = z%v(i) + alpha*y(i)*x(i) + end do + else + do i=1, n + z%v(i) = beta*z%v(i) + alpha*y(i)*x(i) + end do + end if + end if + end if + end subroutine c_base_mlt_a_2 + + subroutine c_base_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy) + use psi_serial_mod + use psb_string_mod + implicit none + complex(psb_spk_), intent(in) :: alpha,beta + class(psb_c_base_vect_type), intent(inout) :: x + class(psb_c_base_vect_type), intent(inout) :: y + class(psb_c_base_vect_type), intent(inout) :: z + integer, intent(out) :: info + character(len=1), intent(in), optional :: conjgx, conjgy + integer :: i, n + + info = 0 + if (present(conjgx)) then + if (psb_toupper(conjgx)=='C') x%v=conjg(x%v) + end if + if (present(conjgy)) then + if (psb_toupper(conjgy)=='C') y%v=conjg(y%v) + end if + call z%mlt(alpha,x%v,y%v,beta,info) + if (present(conjgx)) then + if (psb_toupper(conjgx)=='C') x%v=conjg(x%v) + end if + if (present(conjgy)) then + if (psb_toupper(conjgy)=='C') y%v=conjg(y%v) + end if + + end subroutine c_base_mlt_v_2 + + subroutine c_base_mlt_av(alpha,x,y,beta,z,info) + use psi_serial_mod + implicit none + complex(psb_spk_), intent(in) :: alpha,beta + complex(psb_spk_), intent(in) :: x(:) + class(psb_c_base_vect_type), intent(inout) :: y + class(psb_c_base_vect_type), intent(inout) :: z + integer, intent(out) :: info + integer :: i, n + + info = 0 + + call z%mlt(alpha,x,y%v,beta,info) + + end subroutine c_base_mlt_av + + subroutine c_base_mlt_va(alpha,x,y,beta,z,info) + use psi_serial_mod + implicit none + complex(psb_spk_), intent(in) :: alpha,beta + complex(psb_spk_), intent(in) :: y(:) + class(psb_c_base_vect_type), intent(inout) :: x + class(psb_c_base_vect_type), intent(inout) :: z + integer, intent(out) :: info + integer :: i, n + + info = 0 + + call z%mlt(alpha,y,x,beta,info) + + end subroutine c_base_mlt_va + + subroutine c_base_scal(alpha, x) + use psi_serial_mod + implicit none + class(psb_c_base_vect_type), intent(inout) :: x + complex(psb_spk_), intent (in) :: alpha + + if (allocated(x%v)) x%v = alpha*x%v + + end subroutine c_base_scal + + + function c_base_nrm2(n,x) result(res) + implicit none + class(psb_c_base_vect_type), intent(inout) :: x + integer, intent(in) :: n + real(psb_spk_) :: res + real(psb_spk_), external :: scnrm2 + + res = scnrm2(n,x%v,1) + + end function c_base_nrm2 + + function c_base_amax(n,x) result(res) + implicit none + class(psb_c_base_vect_type), intent(inout) :: x + integer, intent(in) :: n + real(psb_spk_) :: res + + res = maxval(abs(x%v(1:n))) + + end function c_base_amax + + function c_base_asum(n,x) result(res) + implicit none + class(psb_c_base_vect_type), intent(inout) :: x + integer, intent(in) :: n + real(psb_spk_) :: res + + res = sum(abs(x%v(1:n))) + + end function c_base_asum + + subroutine c_base_all(n, x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + integer, intent(in) :: n + class(psb_c_base_vect_type), intent(out) :: x + integer, intent(out) :: info + + call psb_realloc(n,x%v,info) + + end subroutine c_base_all + + subroutine c_base_zero(x) + use psi_serial_mod + implicit none + class(psb_c_base_vect_type), intent(inout) :: x + + if (allocated(x%v)) x%v=czero + + end subroutine c_base_zero + + subroutine c_base_asb(n, x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + integer, intent(in) :: n + class(psb_c_base_vect_type), intent(inout) :: x + integer, intent(out) :: info + + if (x%get_nrows() < n) & + & call psb_realloc(n,x%v,info) + if (info /= 0) & + & call psb_errpush(psb_err_alloc_dealloc_,'vect_asb') + + end subroutine c_base_asb + + subroutine c_base_sync(x) + implicit none + class(psb_c_base_vect_type), intent(inout) :: x + + ! + ! The base version does nothing, it's just + ! a placeholder. + ! + + end subroutine c_base_sync + + subroutine c_base_gthab(n,idx,alpha,x,beta,y) + use psi_serial_mod + integer :: n, idx(:) + complex(psb_spk_) :: alpha, beta, y(:) + class(psb_c_base_vect_type) :: x + + call x%sync() + call psi_gth(n,idx,alpha,x%v,beta,y) + + end subroutine c_base_gthab + + subroutine c_base_gthzv(n,idx,x,y) + use psi_serial_mod + integer :: n, idx(:) + complex(psb_spk_) :: y(:) + class(psb_c_base_vect_type) :: x + + call x%sync() + call psi_gth(n,idx,x%v,y) + + end subroutine c_base_gthzv + + subroutine c_base_sctb(n,idx,x,beta,y) + use psi_serial_mod + integer :: n, idx(:) + complex(psb_spk_) :: beta, x(:) + class(psb_c_base_vect_type) :: y + + call y%sync() + call psi_sct(n,idx,x,beta,y%v) + + end subroutine c_base_sctb + + subroutine c_base_free(x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + class(psb_c_base_vect_type), intent(inout) :: x + integer, intent(out) :: info + + info = 0 + if (allocated(x%v)) deallocate(x%v, stat=info) + if (info /= 0) call & + & psb_errpush(psb_err_alloc_dealloc_,'vect_free') + + end subroutine c_base_free + + subroutine c_base_ins(n,irl,val,dupl,x,info) + use psi_serial_mod + implicit none + class(psb_c_base_vect_type), intent(inout) :: x + integer, intent(in) :: n, dupl + integer, intent(in) :: irl(:) + complex(psb_spk_), intent(in) :: val(:) + integer, intent(out) :: info + + integer :: i + + info = 0 + if (psb_errstatus_fatal()) return + + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + else if (n > min(size(irl),size(val))) then + info = psb_err_invalid_input_ + + else + select case(dupl) + case(psb_dupl_ovwrt_) + do i = 1, n + !loop over all val's rows + + ! row actual block row + if (irl(i) > 0) then + ! this row belongs to me + ! copy i-th row of block val in x + x%v(irl(i)) = val(i) + end if + enddo + + case(psb_dupl_add_) + + do i = 1, n + !loop over all val's rows + + if (irl(i) > 0) then + ! this row belongs to me + ! copy i-th row of block val in x + x%v(irl(i)) = x%v(irl(i)) + val(i) + end if + enddo + + case default + info = 321 +!!$ call psb_errpush(info,name) +!!$ goto 9999 + end select + end if + if (info /= 0) then + call psb_errpush(info,'base_vect_ins') + return + end if + + end subroutine c_base_ins + +end module psb_c_base_vect_mod diff --git a/base/modules/psb_c_comm_mod.f90 b/base/modules/psb_c_comm_mod.f90 new file mode 100644 index 000000000..49b103a61 --- /dev/null +++ b/base/modules/psb_c_comm_mod.f90 @@ -0,0 +1,155 @@ +!!$ +!!$ Parallel Sparse BLAS version 3.0 +!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +module psb_c_comm_mod + + interface psb_ovrl + subroutine psb_covrlm(x,desc_a,info,jx,ik,work,update,mode) + use psb_descriptor_type + complex(psb_spk_), intent(inout), target :: x(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + complex(psb_spk_), intent(inout), optional, target :: work(:) + integer, intent(in), optional :: update,jx,ik,mode + end subroutine psb_covrlm + subroutine psb_covrlv(x,desc_a,info,work,update,mode) + use psb_descriptor_type + complex(psb_spk_), intent(inout), target :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + complex(psb_spk_), intent(inout), optional, target :: work(:) + integer, intent(in), optional :: update,mode + end subroutine psb_covrlv + subroutine psb_covrl_vect(x,desc_a,info,work,update,mode) + use psb_descriptor_type + use psb_c_vect_mod + type(psb_c_vect_type), intent(inout) :: x + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + complex(psb_spk_), intent(inout), optional, target :: work(:) + integer, intent(in), optional :: update,mode + end subroutine psb_covrl_vect + end interface psb_ovrl + + interface psb_halo + subroutine psb_chalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data) + use psb_descriptor_type + complex(psb_spk_), intent(inout), target :: x(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + complex(psb_spk_), intent(in), optional :: alpha + complex(psb_spk_), target, optional, intent(inout) :: work(:) + integer, intent(in), optional :: mode,jx,ik,data + character, intent(in), optional :: tran + end subroutine psb_chalom + subroutine psb_chalov(x,desc_a,info,alpha,work,tran,mode,data) + use psb_descriptor_type + complex(psb_spk_), intent(inout) :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + complex(psb_spk_), intent(in), optional :: alpha + complex(psb_spk_), target, optional, intent(inout) :: work(:) + integer, intent(in), optional :: mode,data + character, intent(in), optional :: tran + end subroutine psb_chalov + subroutine psb_chalo_vect(x,desc_a,info,alpha,work,tran,mode,data) + use psb_descriptor_type + use psb_c_vect_mod + type(psb_c_vect_type), intent(inout) :: x + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + complex(psb_spk_), intent(in), optional :: alpha + complex(psb_spk_), target, optional, intent(inout) :: work(:) + integer, intent(in), optional :: mode,data + character, intent(in), optional :: tran + end subroutine psb_chalo_vect + end interface psb_halo + + + interface psb_scatter + subroutine psb_cscatterm(globx, locx, desc_a, info, root) + use psb_descriptor_type + complex(psb_spk_), intent(out) :: locx(:,:) + complex(psb_spk_), intent(in) :: globx(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, intent(in), optional :: root + end subroutine psb_cscatterm + subroutine psb_cscatterv(globx, locx, desc_a, info, root) + use psb_descriptor_type + complex(psb_spk_), intent(out) :: locx(:) + complex(psb_spk_), intent(in) :: globx(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, intent(in), optional :: root + end subroutine psb_cscatterv + end interface psb_scatter + + interface psb_gather + subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) + use psb_descriptor_type + use psb_mat_mod + implicit none + type(psb_cspmat_type), intent(inout) :: loca + type(psb_cspmat_type), intent(out) :: globa + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, intent(in), optional :: root,dupl + logical, intent(in), optional :: keepnum,keeploc + end subroutine psb_csp_allgather + subroutine psb_cgatherm(globx, locx, desc_a, info, root) + use psb_descriptor_type + complex(psb_spk_), intent(in) :: locx(:,:) + complex(psb_spk_), intent(out) :: globx(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, intent(in), optional :: root + end subroutine psb_cgatherm + subroutine psb_cgatherv(globx, locx, desc_a, info, root) + use psb_descriptor_type + complex(psb_spk_), intent(in) :: locx(:) + complex(psb_spk_), intent(out) :: globx(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, intent(in), optional :: root + end subroutine psb_cgatherv + subroutine psb_cgather_vect(globx, locx, desc_a, info, root) + use psb_descriptor_type + use psb_c_vect_mod + type(psb_c_vect_type), intent(in) :: locx + complex(psb_spk_), intent(out) :: globx(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, intent(in), optional :: root + end subroutine psb_cgather_vect + end interface psb_gather + +end module psb_c_comm_mod diff --git a/base/modules/psb_c_csc_mat_mod.f90 b/base/modules/psb_c_csc_mat_mod.f90 index 2e86c6ed4..028646524 100644 --- a/base/modules/psb_c_csc_mat_mod.f90 +++ b/base/modules/psb_c_csc_mat_mod.f90 @@ -59,7 +59,13 @@ module psb_c_csc_mat_mod procedure, pass(a) :: c_inner_cssv => psb_c_csc_cssv procedure, pass(a) :: c_scals => psb_c_csc_scals procedure, pass(a) :: c_scal => psb_c_csc_scal + procedure, pass(a) :: maxval => psb_c_csc_maxval procedure, pass(a) :: csnmi => psb_c_csc_csnmi + procedure, pass(a) :: csnm1 => psb_c_csc_csnm1 + procedure, pass(a) :: rowsum => psb_c_csc_rowsum + procedure, pass(a) :: arwsum => psb_c_csc_arwsum + procedure, pass(a) :: colsum => psb_c_csc_colsum + procedure, pass(a) :: aclsum => psb_c_csc_aclsum procedure, pass(a) :: reallocate_nz => psb_c_csc_reallocate_nz procedure, pass(a) :: allocate_mnnz => psb_c_csc_allocate_mnnz procedure, pass(a) :: cp_to_coo => psb_c_cp_csc_to_coo @@ -74,7 +80,7 @@ module psb_c_csc_mat_mod procedure, pass(a) :: get_diag => psb_c_csc_get_diag procedure, pass(a) :: csgetptn => psb_c_csc_csgetptn procedure, pass(a) :: c_csgetrow => psb_c_csc_csgetrow - procedure, pass(a) :: get_nc_col => c_csc_get_nc_col +!!$ procedure, pass(a) :: get_nz_col => c_csc_get_nz_col procedure, pass(a) :: reinit => psb_c_csc_reinit procedure, pass(a) :: trim => psb_c_csc_trim procedure, pass(a) :: print => psb_c_csc_print @@ -330,6 +336,13 @@ module psb_c_csc_mat_mod end subroutine psb_c_csc_csmm end interface + interface + function psb_c_csc_maxval(a) result(res) + import :: psb_c_csc_sparse_mat, psb_spk_ + class(psb_c_csc_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + end function psb_c_csc_maxval + end interface interface function psb_c_csc_csnmi(a) result(res) @@ -339,6 +352,46 @@ module psb_c_csc_mat_mod end function psb_c_csc_csnmi end interface + interface + function psb_c_csc_csnm1(a) result(res) + import :: psb_c_csc_sparse_mat, psb_spk_ + class(psb_c_csc_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + end function psb_c_csc_csnm1 + end interface + + interface + subroutine psb_c_csc_rowsum(d,a) + import :: psb_c_csc_sparse_mat, psb_spk_ + class(psb_c_csc_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(out) :: d(:) + end subroutine psb_c_csc_rowsum + end interface + + interface + subroutine psb_c_csc_arwsum(d,a) + import :: psb_c_csc_sparse_mat, psb_spk_ + class(psb_c_csc_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_c_csc_arwsum + end interface + + interface + subroutine psb_c_csc_colsum(d,a) + import :: psb_c_csc_sparse_mat, psb_spk_ + class(psb_c_csc_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(out) :: d(:) + end subroutine psb_c_csc_colsum + end interface + + interface + subroutine psb_c_csc_aclsum(d,a) + import :: psb_c_csc_sparse_mat, psb_spk_ + class(psb_c_csc_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_c_csc_aclsum + end interface + interface subroutine psb_c_csc_get_diag(a,d,info) import :: psb_c_csc_sparse_mat, psb_spk_ diff --git a/base/modules/psb_c_csr_mat_mod.f90 b/base/modules/psb_c_csr_mat_mod.f90 index cf9d98014..58ea137bc 100644 --- a/base/modules/psb_c_csr_mat_mod.f90 +++ b/base/modules/psb_c_csr_mat_mod.f90 @@ -58,7 +58,13 @@ module psb_c_csr_mat_mod procedure, pass(a) :: c_inner_cssv => psb_c_csr_cssv procedure, pass(a) :: c_scals => psb_c_csr_scals procedure, pass(a) :: c_scal => psb_c_csr_scal + procedure, pass(a) :: maxval => psb_c_csr_maxval procedure, pass(a) :: csnmi => psb_c_csr_csnmi + procedure, pass(a) :: csnm1 => psb_c_csr_csnm1 + procedure, pass(a) :: rowsum => psb_c_csr_rowsum + procedure, pass(a) :: arwsum => psb_c_csr_arwsum + procedure, pass(a) :: colsum => psb_c_csr_colsum + procedure, pass(a) :: aclsum => psb_c_csr_aclsum procedure, pass(a) :: reallocate_nz => psb_c_csr_reallocate_nz procedure, pass(a) :: allocate_mnnz => psb_c_csr_allocate_mnnz procedure, pass(a) :: cp_to_coo => psb_c_cp_csr_to_coo @@ -73,7 +79,7 @@ module psb_c_csr_mat_mod procedure, pass(a) :: get_diag => psb_c_csr_get_diag procedure, pass(a) :: csgetptn => psb_c_csr_csgetptn procedure, pass(a) :: c_csgetrow => psb_c_csr_csgetrow - procedure, pass(a) :: get_nc_row => c_csr_get_nc_row +!!$ procedure, pass(a) :: get_nz_row => c_csr_get_nz_row procedure, pass(a) :: reinit => psb_c_csr_reinit procedure, pass(a) :: trim => psb_c_csr_trim procedure, pass(a) :: print => psb_c_csr_print @@ -112,15 +118,6 @@ module psb_c_csr_mat_mod end subroutine psb_c_csr_trim end interface - interface - subroutine psb_c_csr_allocate_mnnz(m,n,a,nz) - import :: psb_c_csr_sparse_mat - integer, intent(in) :: m,n - class(psb_c_csr_sparse_mat), intent(inout) :: a - integer, intent(in), optional :: nz - end subroutine psb_c_csr_allocate_mnnz - end interface - interface subroutine psb_c_csr_mold(a,b,info) import :: psb_c_csr_sparse_mat, psb_c_base_sparse_mat, psb_long_int_k_ @@ -129,6 +126,15 @@ module psb_c_csr_mat_mod integer, intent(out) :: info end subroutine psb_c_csr_mold end interface + + interface + subroutine psb_c_csr_allocate_mnnz(m,n,a,nz) + import :: psb_c_csr_sparse_mat + integer, intent(in) :: m,n + class(psb_c_csr_sparse_mat), intent(inout) :: a + integer, intent(in), optional :: nz + end subroutine psb_c_csr_allocate_mnnz + end interface interface subroutine psb_c_csr_print(iout,a,iv,eirs,eics,head,ivr,ivc) @@ -329,7 +335,14 @@ module psb_c_csr_mat_mod end subroutine psb_c_csr_csmm end interface - + interface + function psb_c_csr_maxval(a) result(res) + import :: psb_c_csr_sparse_mat, psb_spk_ + class(psb_c_csr_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + end function psb_c_csr_maxval + end interface + interface function psb_c_csr_csnmi(a) result(res) import :: psb_c_csr_sparse_mat, psb_spk_ @@ -338,6 +351,46 @@ module psb_c_csr_mat_mod end function psb_c_csr_csnmi end interface + interface + function psb_c_csr_csnm1(a) result(res) + import :: psb_c_csr_sparse_mat, psb_spk_ + class(psb_c_csr_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + end function psb_c_csr_csnm1 + end interface + + interface + subroutine psb_c_csr_rowsum(d,a) + import :: psb_c_csr_sparse_mat, psb_spk_ + class(psb_c_csr_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(out) :: d(:) + end subroutine psb_c_csr_rowsum + end interface + + interface + subroutine psb_c_csr_arwsum(d,a) + import :: psb_c_csr_sparse_mat, psb_spk_ + class(psb_c_csr_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_c_csr_arwsum + end interface + + interface + subroutine psb_c_csr_colsum(d,a) + import :: psb_c_csr_sparse_mat, psb_spk_ + class(psb_c_csr_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(out) :: d(:) + end subroutine psb_c_csr_colsum + end interface + + interface + subroutine psb_c_csr_aclsum(d,a) + import :: psb_c_csr_sparse_mat, psb_spk_ + class(psb_c_csr_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_c_csr_aclsum + end interface + interface subroutine psb_c_csr_get_diag(a,d,info) import :: psb_c_csr_sparse_mat, psb_spk_ diff --git a/base/modules/psb_c_linmap_mod.f90 b/base/modules/psb_c_linmap_mod.f90 index 2a0ab5bb1..f895bacf7 100644 --- a/base/modules/psb_c_linmap_mod.f90 +++ b/base/modules/psb_c_linmap_mod.f90 @@ -52,6 +52,16 @@ module psb_c_linmap_mod integer, intent(out) :: info complex(psb_spk_), optional :: work(:) end subroutine psb_c_map_X2Y + subroutine psb_c_map_X2Y_vect(alpha,x,beta,y,map,info,work) + use psb_c_vect_mod + use psb_linmap_type_mod + implicit none + type(psb_clinmap_type), intent(in) :: map + complex(psb_spk_), intent(in) :: alpha,beta + type(psb_c_vect_type), intent(inout) :: x,y + integer, intent(out) :: info + complex(psb_spk_), optional :: work(:) + end subroutine psb_c_map_X2Y_vect end interface interface psb_map_Y2X @@ -65,6 +75,16 @@ module psb_c_linmap_mod integer, intent(out) :: info complex(psb_spk_), optional :: work(:) end subroutine psb_c_map_Y2X + subroutine psb_c_map_Y2X_vect(alpha,x,beta,y,map,info,work) + use psb_c_vect_mod + use psb_linmap_type_mod + implicit none + type(psb_clinmap_type), intent(in) :: map + complex(psb_spk_), intent(in) :: alpha,beta + type(psb_c_vect_type), intent(inout) :: x,y + integer, intent(out) :: info + complex(psb_spk_), optional :: work(:) + end subroutine psb_c_map_Y2X_vect end interface diff --git a/base/modules/psb_c_mat_mod.f90 b/base/modules/psb_c_mat_mod.f90 index bf1a001ce..403e1dcc9 100644 --- a/base/modules/psb_c_mat_mod.f90 +++ b/base/modules/psb_c_mat_mod.f90 @@ -129,20 +129,26 @@ module psb_c_mat_mod procedure, pass(a) :: c_transc_2mat => psb_c_transc_2mat generic, public :: transc => c_transc_1mat, c_transc_2mat - - ! Computational routines procedure, pass(a) :: get_diag => psb_c_get_diag + procedure, pass(a) :: maxval => psb_c_maxval procedure, pass(a) :: csnmi => psb_c_csnmi + procedure, pass(a) :: csnm1 => psb_c_csnm1 + procedure, pass(a) :: rowsum => psb_c_rowsum + procedure, pass(a) :: arwsum => psb_c_arwsum + procedure, pass(a) :: colsum => psb_c_colsum + procedure, pass(a) :: aclsum => psb_c_aclsum + procedure, pass(a) :: c_csmv_v => psb_c_csmv_vect procedure, pass(a) :: c_csmv => psb_c_csmv procedure, pass(a) :: c_csmm => psb_c_csmm - generic, public :: csmm => c_csmm, c_csmv + generic, public :: csmm => c_csmm, c_csmv, c_csmv_v procedure, pass(a) :: c_scals => psb_c_scals procedure, pass(a) :: c_scal => psb_c_scal generic, public :: scal => c_scals, c_scal + procedure, pass(a) :: c_cssv_v => psb_c_cssv_vect procedure, pass(a) :: c_cssv => psb_c_cssv procedure, pass(a) :: c_cssm => psb_c_cssm - generic, public :: cssm => c_cssm, c_cssv + generic, public :: cssm => c_cssm, c_cssv, c_cssv_v end type psb_cspmat_type @@ -270,7 +276,6 @@ module psb_c_mat_mod end subroutine psb_c_set_upper end interface - interface subroutine psb_c_sparse_print(iout,a,iv,eirs,eics,head,ivr,ivc) import :: psb_cspmat_type @@ -603,6 +608,16 @@ module psb_c_mat_mod integer, intent(out) :: info character, optional, intent(in) :: trans end subroutine psb_c_csmv + subroutine psb_c_csmv_vect(alpha,a,x,beta,y,info,trans) + use psb_c_vect_mod, only : psb_c_vect_type + import :: psb_cspmat_type, psb_spk_ + class(psb_cspmat_type), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta + type(psb_c_vect_type), intent(inout) :: x + type(psb_c_vect_type), intent(inout) :: y + integer, intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_c_csmv_vect end interface interface psb_cssm @@ -624,6 +639,25 @@ module psb_c_mat_mod character, optional, intent(in) :: trans, scale complex(psb_spk_), intent(in), optional :: d(:) end subroutine psb_c_cssv + subroutine psb_c_cssv_vect(alpha,a,x,beta,y,info,trans,scale,d) + use psb_c_vect_mod, only : psb_c_vect_type + import :: psb_cspmat_type, psb_spk_ + class(psb_cspmat_type), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta + type(psb_c_vect_type), intent(inout) :: x + type(psb_c_vect_type), intent(inout) :: y + integer, intent(out) :: info + character, optional, intent(in) :: trans, scale + type(psb_c_vect_type), optional, intent(inout) :: d + end subroutine psb_c_cssv_vect + end interface + + interface + function psb_c_maxval(a) result(res) + import :: psb_cspmat_type, psb_spk_ + class(psb_cspmat_type), intent(in) :: a + real(psb_spk_) :: res + end function psb_c_maxval end interface interface @@ -634,6 +668,51 @@ module psb_c_mat_mod end function psb_c_csnmi end interface + interface + function psb_c_csnm1(a) result(res) + import :: psb_cspmat_type, psb_spk_ + class(psb_cspmat_type), intent(in) :: a + real(psb_spk_) :: res + end function psb_c_csnm1 + end interface + + interface + subroutine psb_c_rowsum(d,a,info) + import :: psb_cspmat_type, psb_spk_ + class(psb_cspmat_type), intent(in) :: a + complex(psb_spk_), intent(out) :: d(:) + integer, intent(out) :: info + end subroutine psb_c_rowsum + end interface + + interface + subroutine psb_c_arwsum(d,a,info) + import :: psb_cspmat_type, psb_spk_ + class(psb_cspmat_type), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + integer, intent(out) :: info + end subroutine psb_c_arwsum + end interface + + interface + subroutine psb_c_colsum(d,a,info) + import :: psb_cspmat_type, psb_spk_ + class(psb_cspmat_type), intent(in) :: a + complex(psb_spk_), intent(out) :: d(:) + integer, intent(out) :: info + end subroutine psb_c_colsum + end interface + + interface + subroutine psb_c_aclsum(d,a,info) + import :: psb_cspmat_type, psb_spk_ + class(psb_cspmat_type), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + integer, intent(out) :: info + end subroutine psb_c_aclsum + end interface + + interface subroutine psb_c_get_diag(a,d,info) import :: psb_cspmat_type, psb_spk_ @@ -659,8 +738,6 @@ module psb_c_mat_mod end interface - - contains diff --git a/base/modules/psb_c_psblas_mod.f90 b/base/modules/psb_c_psblas_mod.f90 index a1c81cc1f..e3be39535 100644 --- a/base/modules/psb_c_psblas_mod.f90 +++ b/base/modules/psb_c_psblas_mod.f90 @@ -32,6 +32,14 @@ module psb_c_psblas_mod interface psb_gedot + function psb_cdot_vect(x, y, desc_a,info) result(res) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + use psb_c_vect_mod, only : psb_c_vect_type + complex(psb_spk_) :: res + type(psb_c_vect_type), intent(inout) :: x, y + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + end function psb_cdot_vect function psb_cdotv(x, y, desc_a,info) use psb_descriptor_type, only : psb_desc_type, psb_spk_ complex(psb_spk_) :: psb_cdotv @@ -68,6 +76,16 @@ module psb_c_psblas_mod end interface interface psb_geaxpby + subroutine psb_caxpby_vect(alpha, x, beta, y,& + & desc_a, info) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + use psb_c_vect_mod, only : psb_c_vect_type + type(psb_c_vect_type), intent (inout) :: x + type(psb_c_vect_type), intent (inout) :: y + complex(psb_spk_), intent (in) :: alpha, beta + type(psb_desc_type), intent (in) :: desc_a + integer, intent(out) :: info + end subroutine psb_caxpby_vect subroutine psb_caxpbyv(alpha, x, beta, y,& & desc_a, info) use psb_descriptor_type, only : psb_desc_type, psb_spk_ @@ -105,6 +123,14 @@ module psb_c_psblas_mod type(psb_desc_type), intent (in) :: desc_a integer, intent(out) :: info end function psb_camaxv + function psb_camax_vect(x, desc_a, info) result(res) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + use psb_c_vect_mod, only : psb_c_vect_type + real(psb_spk_) :: res + type(psb_c_vect_type), intent (inout) :: x + type(psb_desc_type), intent (in) :: desc_a + integer, intent(out) :: info + end function psb_camax_vect end interface interface psb_geamaxs @@ -126,6 +152,14 @@ module psb_c_psblas_mod end interface interface psb_geasum + function psb_casum_vect(x, desc_a, info) result(res) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + use psb_c_vect_mod, only : psb_c_vect_type + real(psb_spk_) :: res + type(psb_c_vect_type), intent (inout) :: x + type(psb_desc_type), intent (in) :: desc_a + integer, intent(out) :: info + end function psb_casum_vect function psb_casum(x, desc_a, info, jx) use psb_descriptor_type, only : psb_desc_type, psb_spk_ real(psb_spk_) psb_casum @@ -177,6 +211,14 @@ module psb_c_psblas_mod type(psb_desc_type), intent (in) :: desc_a integer, intent(out) :: info end function psb_cnrm2v + function psb_cnrm2_vect(x, desc_a, info) result(res) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + use psb_c_vect_mod, only : psb_c_vect_type + real(psb_spk_) :: res + type(psb_c_vect_type), intent (inout) :: x + type(psb_desc_type), intent (in) :: desc_a + integer, intent(out) :: info + end function psb_cnrm2_vect end interface interface psb_genrm2s @@ -201,6 +243,17 @@ module psb_c_psblas_mod end function psb_cnrmi end interface + interface psb_spnrm1 + function psb_cspnrm1(a, desc_a,info) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + use psb_mat_mod, only : psb_cspmat_type + real(psb_spk_) :: psb_cspnrm1 + type(psb_cspmat_type), intent (in) :: a + type(psb_desc_type), intent (in) :: desc_a + integer, intent(out) :: info + end function psb_cspnrm1 + end interface + interface psb_spmm subroutine psb_cspmm(alpha, a, x, beta, y, desc_a, info,& &trans, k, jx, jy,work,doswap) @@ -231,6 +284,21 @@ module psb_c_psblas_mod logical, optional, intent(in) :: doswap integer, intent(out) :: info end subroutine psb_cspmv + subroutine psb_cspmv_vect(alpha, a, x, beta, y,& + & desc_a, info, trans, work,doswap) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + use psb_c_vect_mod, only : psb_c_vect_type + use psb_mat_mod, only : psb_cspmat_type + type(psb_cspmat_type), intent(in) :: a + type(psb_c_vect_type), intent(inout) :: x + type(psb_c_vect_type), intent(inout) :: y + complex(psb_spk_), intent(in) :: alpha, beta + type(psb_desc_type), intent(in) :: desc_a + character, optional, intent(in) :: trans + complex(psb_spk_), optional, intent(inout),target :: work(:) + logical, optional, intent(in) :: doswap + integer, intent(out) :: info + end subroutine psb_cspmv_vect end interface interface psb_spsm @@ -267,6 +335,23 @@ module psb_c_psblas_mod complex(psb_spk_), optional, intent(inout), target :: work(:) integer, intent(out) :: info end subroutine psb_cspsv + subroutine psb_cspsv_vect(alpha, t, x, beta, y,& + & desc_a, info, trans, scale, choice,& + & diag, work) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + use psb_c_vect_mod, only : psb_c_vect_type + use psb_mat_mod, only : psb_cspmat_type + type(psb_cspmat_type), intent(inout) :: t + type(psb_c_vect_type), intent(inout) :: x + type(psb_c_vect_type), intent(inout) :: y + complex(psb_spk_), intent(in) :: alpha, beta + type(psb_desc_type), intent(in) :: desc_a + character, optional, intent(in) :: trans, scale + integer, optional, intent(in) :: choice + type(psb_c_vect_type), intent(inout), optional :: diag + complex(psb_spk_), optional, intent(inout), target :: work(:) + integer, intent(out) :: info + end subroutine psb_cspsv_vect end interface end module psb_c_psblas_mod diff --git a/base/modules/psb_c_tools_mod.f90 b/base/modules/psb_c_tools_mod.f90 index 6a818d734..22ee43a5c 100644 --- a/base/modules/psb_c_tools_mod.f90 +++ b/base/modules/psb_c_tools_mod.f90 @@ -48,6 +48,22 @@ Module psb_c_tools_mod integer, intent(out) :: info integer, optional, intent(in) :: n end subroutine psb_callocv + subroutine psb_calloc_vect(x, desc_a,info,n) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + use psb_c_vect_mod + type(psb_c_vect_type), intent(out) :: x + type(psb_desc_type), intent(in) :: desc_a + integer,intent(out) :: info + integer, optional, intent(in) :: n + end subroutine psb_calloc_vect + subroutine psb_calloc_vect_r2(x, desc_a,info,n,lb) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + use psb_c_vect_mod + type(psb_c_vect_type), allocatable, intent(out) :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer,intent(out) :: info + integer, optional, intent(in) :: n, lb + end subroutine psb_calloc_vect_r2 end interface @@ -64,6 +80,22 @@ Module psb_c_tools_mod complex(psb_spk_), allocatable, intent(inout) :: x(:) integer, intent(out) :: info end subroutine psb_casbv + subroutine psb_casb_vect(x, desc_a, info,mold) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + use psb_c_vect_mod + type(psb_desc_type), intent(in) :: desc_a + type(psb_c_vect_type), intent(inout) :: x + integer, intent(out) :: info + class(psb_c_base_vect_type), intent(in), optional :: mold + end subroutine psb_casb_vect + subroutine psb_casb_vect_r2(x, desc_a, info,mold) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + use psb_c_vect_mod + type(psb_desc_type), intent(in) :: desc_a + type(psb_c_vect_type), intent(inout) :: x(:) + integer, intent(out) :: info + class(psb_c_base_vect_type), intent(in), optional :: mold + end subroutine psb_casb_vect_r2 end interface interface psb_sphalo @@ -94,6 +126,20 @@ Module psb_c_tools_mod type(psb_desc_type), intent(in) :: desc_a integer, intent(out) :: info end subroutine psb_cfreev + subroutine psb_cfree_vect(x, desc_a, info) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + use psb_c_vect_mod + type(psb_desc_type), intent(in) :: desc_a + type(psb_c_vect_type), intent(inout) :: x + integer, intent(out) :: info + end subroutine psb_cfree_vect + subroutine psb_cfree_vect_r2(x, desc_a, info) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + use psb_c_vect_mod + type(psb_desc_type), intent(in) :: desc_a + type(psb_c_vect_type), allocatable, intent(inout) :: x(:) + integer, intent(out) :: info + end subroutine psb_cfree_vect_r2 end interface @@ -118,9 +164,30 @@ Module psb_c_tools_mod integer, intent(out) :: info integer, optional, intent(in) :: dupl end subroutine psb_cinsvi + subroutine psb_cins_vect(m,irw,val,x,desc_a,info,dupl) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + use psb_c_vect_mod + integer, intent(in) :: m + type(psb_desc_type), intent(in) :: desc_a + type(psb_c_vect_type), intent(inout) :: x + integer, intent(in) :: irw(:) + complex(psb_spk_), intent(in) :: val(:) + integer, intent(out) :: info + integer, optional, intent(in) :: dupl + end subroutine psb_cins_vect + subroutine psb_cins_vect_r2(m,irw,val,x,desc_a,info,dupl) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + use psb_c_vect_mod + integer, intent(in) :: m + type(psb_desc_type), intent(in) :: desc_a + type(psb_c_vect_type), intent(inout) :: x(:) + integer, intent(in) :: irw(:) + complex(psb_spk_), intent(in) :: val(:,:) + integer, intent(out) :: info + integer, optional, intent(in) :: dupl + end subroutine psb_cins_vect_r2 end interface - interface psb_cdbldext Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info,extype) use psb_descriptor_type, only : psb_desc_type, psb_spk_ @@ -204,90 +271,5 @@ Module psb_c_tools_mod end subroutine psb_csprn end interface -!!$ -!!$ interface psb_linmap_init -!!$ module procedure psb_clinmap_init -!!$ end interface -!!$ -!!$ interface psb_linmap_ins -!!$ module procedure psb_clinmap_ins -!!$ end interface -!!$ -!!$ interface psb_linmap_asb -!!$ module procedure psb_clinmap_asb -!!$ end interface -!!$ -!!$contains -!!$ subroutine psb_clinmap_init(a_map,cd_xt,descin,descout) -!!$ use psb_base_tools_mod -!!$ use psb_c_mat_mod -!!$ use psb_descriptor_type -!!$ use psb_serial_mod -!!$ use psb_penv_mod -!!$ use psb_error_mod -!!$ implicit none -!!$ type(psb_cspmat_type), intent(out) :: a_map -!!$ type(psb_desc_type), intent(out) :: cd_xt -!!$ type(psb_desc_type), intent(in) :: descin, descout -!!$ -!!$ integer :: nrow_in, nrow_out, ncol_in, info, ictxt -!!$ -!!$ ictxt = psb_cd_get_context(descin) -!!$ -!!$ call psb_cdcpy(descin,cd_xt,info) -!!$ if (info == psb_success_) call psb_cd_reinit(cd_xt,info) -!!$ if (info /= psb_success_) then -!!$ write(psb_err_unit,*) 'Error on reinitialising the extension map' -!!$ call psb_error(ictxt) -!!$ call psb_abort(ictxt) -!!$ stop -!!$ end if -!!$ -!!$ nrow_in = psb_cd_get_local_rows(cd_xt) -!!$ ncol_in = psb_cd_get_local_cols(cd_xt) -!!$ nrow_out = psb_cd_get_local_rows(descout) -!!$ -!!$ call a_map%csall(nrow_out,ncol_in,info) -!!$ -!!$ end subroutine psb_clinmap_init -!!$ -!!$ subroutine psb_clinmap_ins(nz,ir,ic,val,a_map,cd_xt,descin,descout) -!!$ use psb_base_tools_mod -!!$ use psb_c_mat_mod -!!$ use psb_descriptor_type -!!$ implicit none -!!$ integer, intent(in) :: nz -!!$ integer, intent(in) :: ir(:),ic(:) -!!$ complex(psb_spk_), intent(in) :: val(:) -!!$ type(psb_cspmat_type), intent(inout) :: a_map -!!$ type(psb_desc_type), intent(inout) :: cd_xt -!!$ type(psb_desc_type), intent(in) :: descin, descout -!!$ integer :: info -!!$ -!!$ call psb_spins(nz,ir,ic,val,a_map,descout,cd_xt,info) -!!$ -!!$ end subroutine psb_clinmap_ins -!!$ -!!$ subroutine psb_clinmap_asb(a_map,cd_xt,descin,descout,afmt) -!!$ use psb_base_tools_mod -!!$ use psb_c_mat_mod -!!$ use psb_descriptor_type -!!$ use psb_serial_mod -!!$ implicit none -!!$ type(psb_cspmat_type), intent(inout) :: a_map -!!$ type(psb_desc_type), intent(inout) :: cd_xt -!!$ type(psb_desc_type), intent(in) :: descin, descout -!!$ character(len=*), optional, intent(in) :: afmt -!!$ -!!$ integer :: nrow_in, nrow_out, ncol_in, info, ictxt -!!$ -!!$ ictxt = psb_cd_get_context(descin) -!!$ -!!$ call psb_cdasb(cd_xt,info) -!!$ call a_map%set_ncols(psb_cd_get_local_cols(cd_xt)) -!!$ call a_map%cscnv(info,type=afmt) -!!$ -!!$ end subroutine psb_clinmap_asb - end module psb_c_tools_mod diff --git a/base/modules/psb_c_vect_mod.f90 b/base/modules/psb_c_vect_mod.f90 new file mode 100644 index 000000000..c285a262c --- /dev/null +++ b/base/modules/psb_c_vect_mod.f90 @@ -0,0 +1,504 @@ +module psb_c_vect_mod + + use psb_c_base_vect_mod + + type psb_c_vect_type + class(psb_c_base_vect_type), allocatable :: v + contains + procedure, pass(x) :: get_nrows => c_vect_get_nrows + procedure, pass(x) :: dot_v => c_vect_dot_v + procedure, pass(x) :: dot_a => c_vect_dot_a + generic, public :: dot => dot_v, dot_a + procedure, pass(y) :: axpby_v => c_vect_axpby_v + procedure, pass(y) :: axpby_a => c_vect_axpby_a + generic, public :: axpby => axpby_v, axpby_a + procedure, pass(y) :: mlt_v => c_vect_mlt_v + procedure, pass(y) :: mlt_a => c_vect_mlt_a + procedure, pass(z) :: mlt_a_2 => c_vect_mlt_a_2 + procedure, pass(z) :: mlt_v_2 => c_vect_mlt_v_2 + procedure, pass(z) :: mlt_va => c_vect_mlt_va + procedure, pass(z) :: mlt_av => c_vect_mlt_av + generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,& + & mlt_v_2, mlt_av, mlt_va + procedure, pass(x) :: scal => c_vect_scal + procedure, pass(x) :: nrm2 => c_vect_nrm2 + procedure, pass(x) :: amax => c_vect_amax + procedure, pass(x) :: asum => c_vect_asum + procedure, pass(x) :: all => c_vect_all + procedure, pass(x) :: zero => c_vect_zero + procedure, pass(x) :: asb => c_vect_asb + procedure, pass(x) :: sync => c_vect_sync + procedure, pass(x) :: gthab => c_vect_gthab + procedure, pass(x) :: gthzv => c_vect_gthzv + generic, public :: gth => gthab, gthzv + procedure, pass(y) :: sctb => c_vect_sctb + generic, public :: sct => sctb + procedure, pass(x) :: free => c_vect_free + procedure, pass(x) :: ins => c_vect_ins + procedure, pass(x) :: bld_x => c_vect_bld_x + procedure, pass(x) :: bld_n => c_vect_bld_n + generic, public :: bld => bld_x, bld_n + procedure, pass(x) :: getCopy => c_vect_getCopy + procedure, pass(x) :: cpy_vect => c_vect_cpy_vect + generic, public :: assignment(=) => cpy_vect + procedure, pass(x) :: cnv => c_vect_cnv + procedure, pass(x) :: set_scal => c_vect_set_scal + procedure, pass(x) :: set_vect => c_vect_set_vect + generic, public :: set => set_vect, set_scal + end type psb_c_vect_type + + public :: psb_c_vect + private :: constructor, size_const + interface psb_c_vect + module procedure constructor, size_const + end interface psb_c_vect + +contains + + subroutine c_vect_bld_x(x,invect,mold) + complex(psb_spk_), intent(in) :: invect(:) + class(psb_c_vect_type), intent(out) :: x + class(psb_c_base_vect_type), intent(in), optional :: mold + integer :: info + + if (present(mold)) then + allocate(x%v,stat=info,mold=mold) + else + allocate(psb_c_base_vect_type :: x%v,stat=info) + endif + + if (info == psb_success_) call x%v%bld(invect) + + end subroutine c_vect_bld_x + + + subroutine c_vect_bld_n(x,n,mold) + integer, intent(in) :: n + class(psb_c_vect_type), intent(out) :: x + class(psb_c_base_vect_type), intent(in), optional :: mold + integer :: info + + if (present(mold)) then + allocate(x%v,stat=info,mold=mold) + else + allocate(psb_c_base_vect_type :: x%v,stat=info) + endif + if (info == psb_success_) call x%v%bld(n) + + end subroutine c_vect_bld_n + + function c_vect_getCopy(x) result(res) + class(psb_c_vect_type), intent(in) :: x + complex(psb_spk_), allocatable :: res(:) + integer :: info + + if (allocated(x%v)) res = x%v%getCopy() + + end function c_vect_getCopy + + subroutine c_vect_cpy_vect(res,x) + complex(psb_spk_), allocatable, intent(out) :: res(:) + class(psb_c_vect_type), intent(in) :: x + integer :: info + + if (allocated(x%v)) res = x%v + + end subroutine c_vect_cpy_vect + + subroutine c_vect_set_scal(x,val) + class(psb_c_vect_type), intent(inout) :: x + complex(psb_spk_), intent(in) :: val + + integer :: info + if (allocated(x%v)) call x%v%set(val) + + end subroutine c_vect_set_scal + + subroutine c_vect_set_vect(x,val) + class(psb_c_vect_type), intent(inout) :: x + complex(psb_spk_), intent(in) :: val(:) + + integer :: info + if (allocated(x%v)) call x%v%set(val) + + end subroutine c_vect_set_vect + + + function constructor(x) result(this) + complex(psb_spk_) :: x(:) + type(psb_c_vect_type) :: this + integer :: info + + allocate(psb_c_base_vect_type :: this%v, stat=info) + + if (info == 0) call this%v%bld(x) + + call this%asb(size(x),info) + + end function constructor + + + function size_const(n) result(this) + integer, intent(in) :: n + type(psb_c_vect_type) :: this + integer :: info + + allocate(psb_c_base_vect_type :: this%v, stat=info) + call this%asb(n,info) + + end function size_const + + + function c_vect_get_nrows(x) result(res) + implicit none + class(psb_c_vect_type), intent(in) :: x + integer :: res + res = -1 + if (allocated(x%v)) res = x%v%get_nrows() + end function c_vect_get_nrows + + function c_vect_dot_v(n,x,y) result(res) + implicit none + class(psb_c_vect_type), intent(inout) :: x, y + integer, intent(in) :: n + complex(psb_spk_) :: res + + res = czero + if (allocated(x%v).and.allocated(y%v)) & + & res = x%v%dot(n,y%v) + + end function c_vect_dot_v + + function c_vect_dot_a(n,x,y) result(res) + implicit none + class(psb_c_vect_type), intent(inout) :: x + complex(psb_spk_), intent(in) :: y(:) + integer, intent(in) :: n + complex(psb_spk_) :: res + + res = czero + if (allocated(x%v)) & + & res = x%v%dot(n,y) + + end function c_vect_dot_a + + subroutine c_vect_axpby_v(m,alpha, x, beta, y, info) + use psi_serial_mod + implicit none + integer, intent(in) :: m + class(psb_c_vect_type), intent(inout) :: x + class(psb_c_vect_type), intent(inout) :: y + complex(psb_spk_), intent (in) :: alpha, beta + integer, intent(out) :: info + + if (allocated(x%v).and.allocated(y%v)) then + call y%v%axpby(m,alpha,x%v,beta,info) + else + info = psb_err_invalid_vect_state_ + end if + + end subroutine c_vect_axpby_v + + subroutine c_vect_axpby_a(m,alpha, x, beta, y, info) + use psi_serial_mod + implicit none + integer, intent(in) :: m + complex(psb_spk_), intent(in) :: x(:) + class(psb_c_vect_type), intent(inout) :: y + complex(psb_spk_), intent (in) :: alpha, beta + integer, intent(out) :: info + + if (allocated(y%v)) & + & call y%v%axpby(m,alpha,x,beta,info) + + end subroutine c_vect_axpby_a + + + subroutine c_vect_mlt_v(x, y, info) + use psi_serial_mod + implicit none + class(psb_c_vect_type), intent(inout) :: x + class(psb_c_vect_type), intent(inout) :: y + integer, intent(out) :: info + integer :: i, n + + info = 0 + if (allocated(x%v).and.allocated(y%v)) & + & call y%v%mlt(x%v,info) + + end subroutine c_vect_mlt_v + + subroutine c_vect_mlt_a(x, y, info) + use psi_serial_mod + implicit none + complex(psb_spk_), intent(in) :: x(:) + class(psb_c_vect_type), intent(inout) :: y + integer, intent(out) :: info + integer :: i, n + + + info = 0 + if (allocated(y%v)) & + & call y%v%mlt(x,info) + + end subroutine c_vect_mlt_a + + + subroutine c_vect_mlt_a_2(alpha,x,y,beta,z,info) + use psi_serial_mod + implicit none + complex(psb_spk_), intent(in) :: alpha,beta + complex(psb_spk_), intent(in) :: y(:) + complex(psb_spk_), intent(in) :: x(:) + class(psb_c_vect_type), intent(inout) :: z + integer, intent(out) :: info + integer :: i, n + + info = 0 + if (allocated(z%v)) & + & call z%v%mlt(alpha,x,y,beta,info) + + end subroutine c_vect_mlt_a_2 + + subroutine c_vect_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy) + use psi_serial_mod + implicit none + complex(psb_spk_), intent(in) :: alpha,beta + class(psb_c_vect_type), intent(inout) :: x + class(psb_c_vect_type), intent(inout) :: y + class(psb_c_vect_type), intent(inout) :: z + integer, intent(out) :: info + character(len=1), intent(in), optional :: conjgx, conjgy + integer :: i, n + + info = 0 + if (allocated(x%v).and.allocated(y%v).and.& + & allocated(z%v)) & + & call z%v%mlt(alpha,x%v,y%v,beta,info,conjgx,conjgy) + + end subroutine c_vect_mlt_v_2 + + subroutine c_vect_mlt_av(alpha,x,y,beta,z,info) + use psi_serial_mod + implicit none + complex(psb_spk_), intent(in) :: alpha,beta + complex(psb_spk_), intent(in) :: x(:) + class(psb_c_vect_type), intent(inout) :: y + class(psb_c_vect_type), intent(inout) :: z + integer, intent(out) :: info + integer :: i, n + + info = 0 + if (allocated(z%v).and.allocated(y%v)) & + & call z%v%mlt(alpha,x,y%v,beta,info) + + end subroutine c_vect_mlt_av + + subroutine c_vect_mlt_va(alpha,x,y,beta,z,info) + use psi_serial_mod + implicit none + complex(psb_spk_), intent(in) :: alpha,beta + complex(psb_spk_), intent(in) :: y(:) + class(psb_c_vect_type), intent(inout) :: x + class(psb_c_vect_type), intent(inout) :: z + integer, intent(out) :: info + integer :: i, n + + info = 0 + + if (allocated(z%v).and.allocated(x%v)) & + & call z%v%mlt(alpha,x%v,y,beta,info) + + end subroutine c_vect_mlt_va + + subroutine c_vect_scal(alpha, x) + use psi_serial_mod + implicit none + class(psb_c_vect_type), intent(inout) :: x + complex(psb_spk_), intent (in) :: alpha + + if (allocated(x%v)) call x%v%scal(alpha) + + end subroutine c_vect_scal + + + function c_vect_nrm2(n,x) result(res) + implicit none + class(psb_c_vect_type), intent(inout) :: x + integer, intent(in) :: n + real(psb_spk_) :: res + + if (allocated(x%v)) then + res = x%v%nrm2(n) + else + res = szero + end if + + end function c_vect_nrm2 + + function c_vect_amax(n,x) result(res) + implicit none + class(psb_c_vect_type), intent(inout) :: x + integer, intent(in) :: n + real(psb_spk_) :: res + + if (allocated(x%v)) then + res = x%v%amax(n) + else + res = szero + end if + + end function c_vect_amax + + function c_vect_asum(n,x) result(res) + implicit none + class(psb_c_vect_type), intent(inout) :: x + integer, intent(in) :: n + real(psb_spk_) :: res + + if (allocated(x%v)) then + res = x%v%asum(n) + else + res = szero + end if + + end function c_vect_asum + + subroutine c_vect_all(n, x, info, mold) + + implicit none + integer, intent(in) :: n + class(psb_c_vect_type), intent(out) :: x + class(psb_c_base_vect_type), intent(in), optional :: mold + integer, intent(out) :: info + + if (present(mold)) then + allocate(x%v,stat=info,mold=mold) + else + allocate(psb_c_base_vect_type :: x%v,stat=info) + endif + if (info == 0) then + call x%v%all(n,info) + else + info = psb_err_alloc_dealloc_ + end if + + end subroutine c_vect_all + + subroutine c_vect_zero(x) + use psi_serial_mod + implicit none + class(psb_c_vect_type), intent(inout) :: x + + if (allocated(x%v)) call x%v%zero() + + end subroutine c_vect_zero + + subroutine c_vect_asb(n, x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + integer, intent(in) :: n + class(psb_c_vect_type), intent(inout) :: x + integer, intent(out) :: info + + if (allocated(x%v)) & + & call x%v%asb(n,info) + + end subroutine c_vect_asb + + subroutine c_vect_sync(x) + implicit none + class(psb_c_vect_type), intent(inout) :: x + + if (allocated(x%v)) & + & call x%v%sync() + + end subroutine c_vect_sync + + subroutine c_vect_gthab(n,idx,alpha,x,beta,y) + use psi_serial_mod + integer :: n, idx(:) + complex(psb_spk_) :: alpha, beta, y(:) + class(psb_c_vect_type) :: x + + if (allocated(x%v)) & + & call x%v%gth(n,idx,alpha,beta,y) + + end subroutine c_vect_gthab + + subroutine c_vect_gthzv(n,idx,x,y) + use psi_serial_mod + integer :: n, idx(:) + complex(psb_spk_) :: y(:) + class(psb_c_vect_type) :: x + + if (allocated(x%v)) & + & call x%v%gth(n,idx,y) + + end subroutine c_vect_gthzv + + subroutine c_vect_sctb(n,idx,x,beta,y) + use psi_serial_mod + integer :: n, idx(:) + complex(psb_spk_) :: beta, x(:) + class(psb_c_vect_type) :: y + + if (allocated(y%v)) & + & call y%v%sct(n,idx,x,beta) + + end subroutine c_vect_sctb + + subroutine c_vect_free(x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + class(psb_c_vect_type), intent(inout) :: x + integer, intent(out) :: info + + info = 0 + if (allocated(x%v)) then + call x%v%free(info) + if (info == 0) deallocate(x%v,stat=info) + end if + + end subroutine c_vect_free + + subroutine c_vect_ins(n,irl,val,dupl,x,info) + use psi_serial_mod + implicit none + class(psb_c_vect_type), intent(inout) :: x + integer, intent(in) :: n, dupl + integer, intent(in) :: irl(:) + complex(psb_spk_), intent(in) :: val(:) + integer, intent(out) :: info + + integer :: i + + info = 0 + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + return + end if + + call x%v%ins(n,irl,val,dupl,info) + + end subroutine c_vect_ins + + + subroutine c_vect_cnv(x,mold) + class(psb_c_vect_type), intent(inout) :: x + class(psb_c_base_vect_type), intent(in) :: mold + class(psb_c_base_vect_type), allocatable :: tmp + complex(psb_spk_), allocatable :: invect(:) + integer :: info + + allocate(tmp,stat=info,mold=mold) + call x%v%sync() + if (info == psb_success_) call tmp%bld(x%v%v) + call x%v%free(info) + call move_alloc(tmp,x%v) + + end subroutine c_vect_cnv + +end module psb_c_vect_mod diff --git a/base/modules/psb_check_mod.f90 b/base/modules/psb_check_mod.f90 index 7185e9923..d765c4f62 100644 --- a/base/modules/psb_check_mod.f90 +++ b/base/modules/psb_check_mod.f90 @@ -103,45 +103,45 @@ contains info=psb_err_iarg_pos_ int_err(1) = 5 int_err(2) = jx - else if (psb_cd_get_local_cols(desc_dec) < 0) then + else if (desc_dec%get_local_cols() < 0) then info=psb_err_iarg_invalid_i_ int_err(1) = 6 int_err(2) = psb_n_col_ - int_err(3) = psb_cd_get_local_cols(desc_dec) - else if (psb_cd_get_local_rows(desc_dec) < 0) then + int_err(3) = desc_dec%get_local_cols() + else if (desc_dec%get_local_rows() < 0) then info=psb_err_iarg_invalid_i_ int_err(1) = 6 int_err(2) = psb_n_row_ - int_err(3) = psb_cd_get_local_cols(desc_dec) - else if (lldx < psb_cd_get_local_cols(desc_dec)) then + int_err(3) = desc_dec%get_local_cols() + else if (lldx < desc_dec%get_local_cols()) then info=psb_err_iarg_not_gtia_ii_ int_err(1) = 3 int_err(2) = lldx int_err(3) = 6 int_err(4) = psb_n_col_ - int_err(5) = psb_cd_get_local_cols(desc_dec) - else if (psb_cd_get_global_cols(desc_dec) < m) then + int_err(5) = desc_dec%get_local_cols() + else if (desc_dec%get_global_cols() < m) then info=psb_err_iarg_not_gteia_ii_ int_err(1) = 1 int_err(2) = m int_err(3) = 6 int_err(4) = psb_n_ - int_err(5) = psb_cd_get_global_cols(desc_dec) - else if (psb_cd_get_global_cols(desc_dec) < ix) then + int_err(5) = desc_dec%get_global_cols() + else if (desc_dec%get_global_cols() < ix) then info=psb_err_iarg_not_gteia_ii_ int_err(1) = 4 int_err(2) = ix int_err(3) = 6 int_err(4) = psb_n_ - int_err(5) = psb_cd_get_global_cols(desc_dec) - else if (psb_cd_get_global_rows(desc_dec) < jx) then + int_err(5) = desc_dec%get_global_cols() + else if (desc_dec%get_global_rows() < jx) then info=psb_err_iarg_not_gteia_ii_ int_err(1) = 5 int_err(2) = jx int_err(3) = 6 int_err(4) = psb_m_ - int_err(5) = psb_cd_get_global_rows(desc_dec) - else if (psb_cd_get_global_cols(desc_dec) < (ix+m-1)) then + int_err(5) = desc_dec%get_global_rows() + else if (desc_dec%get_global_cols() < (ix+m-1)) then info=psb_err_iarg2_neg_ int_err(1) = 1 int_err(2) = m @@ -228,45 +228,45 @@ contains info=psb_err_iarg_pos_ int_err(1) = 5 int_err(2) = jx - else if (psb_cd_get_local_cols(desc_dec) < 0) then + else if (desc_dec%get_local_cols() < 0) then info=psb_err_iarg_invalid_i_ int_err(1) = 6 int_err(2) = psb_n_col_ - int_err(3) = psb_cd_get_local_cols(desc_dec) - else if (psb_cd_get_local_rows(desc_dec) < 0) then + int_err(3) = desc_dec%get_local_cols() + else if (desc_dec%get_local_rows() < 0) then info=psb_err_iarg_invalid_i_ int_err(1) = 6 int_err(2) = psb_n_row_ - int_err(3) = psb_cd_get_local_rows(desc_dec) - else if (lldx < psb_cd_get_global_rows(desc_dec)) then + int_err(3) = desc_dec%get_local_rows() + else if (lldx < desc_dec%get_global_rows()) then info=psb_err_iarg_not_gtia_ii_ int_err(1) = 3 int_err(2) = lldx int_err(3) = 6 int_err(4) = psb_n_col_ - int_err(5) = psb_cd_get_global_rows(desc_dec) - else if (psb_cd_get_global_cols(desc_dec) < m) then + int_err(5) = desc_dec%get_global_rows() + else if (desc_dec%get_global_cols() < m) then info=psb_err_iarg_not_gteia_ii_ int_err(1) = 1 int_err(2) = m int_err(3) = 6 int_err(4) = psb_n_ - int_err(5) = psb_cd_get_global_cols(desc_dec) - else if (psb_cd_get_global_cols(desc_dec) < ix) then + int_err(5) = desc_dec%get_global_cols() + else if (desc_dec%get_global_cols() < ix) then info=psb_err_iarg_not_gteia_ii_ int_err(1) = 4 int_err(2) = ix int_err(3) = 6 int_err(4) = psb_n_ - int_err(5) = psb_cd_get_global_cols(desc_dec) - else if (psb_cd_get_global_rows(desc_dec) < jx) then + int_err(5) = desc_dec%get_global_cols() + else if (desc_dec%get_global_rows() < jx) then info=psb_err_iarg_not_gteia_ii_ int_err(1) = 5 int_err(2) = jx int_err(3) = 6 int_err(4) = psb_m_ - int_err(5) = psb_cd_get_global_rows(desc_dec) - else if (psb_cd_get_global_cols(desc_dec) < (ix+m-1)) then + int_err(5) = desc_dec%get_global_rows() + else if (desc_dec%get_global_cols() < (ix+m-1)) then info=psb_err_iarg2_neg_ int_err(1) = 1 int_err(2) = m @@ -351,51 +351,51 @@ contains info=psb_err_iarg_pos_ int_err(1) = 5 int_err(2) = ja - else if (psb_cd_get_local_cols(desc_dec) < 0) then + else if (desc_dec%get_local_cols() < 0) then info=psb_err_iarg_invalid_i_ int_err(1) = 6 int_err(2) = psb_n_col_ - int_err(3) = psb_cd_get_local_cols(desc_dec) - else if (psb_cd_get_local_rows(desc_dec) < 0) then + int_err(3) = desc_dec%get_local_cols() + else if (desc_dec%get_local_rows() < 0) then info=psb_err_iarg_invalid_i_ int_err(1) = 6 int_err(2) = psb_n_row_ - int_err(3) = psb_cd_get_local_rows(desc_dec) - else if (psb_cd_get_global_rows(desc_dec) < m) then + int_err(3) = desc_dec%get_local_rows() + else if (desc_dec%get_global_rows() < m) then info=psb_err_iarg_not_gteia_ii_ int_err(1) = 1 int_err(2) = m int_err(3) = 5 int_err(4) = psb_m_ - int_err(5) = psb_cd_get_global_rows(desc_dec) - else if (psb_cd_get_global_rows(desc_dec) < m) then + int_err(5) = desc_dec%get_global_rows() + else if (desc_dec%get_global_rows() < m) then info=psb_err_iarg_not_gteia_ii_ int_err(1) = 2 int_err(2) = n int_err(3) = 5 int_err(4) = psb_m_ - int_err(5) = psb_cd_get_global_rows(desc_dec) - else if (psb_cd_get_global_rows(desc_dec) < ia) then + int_err(5) = desc_dec%get_global_rows() + else if (desc_dec%get_global_rows() < ia) then info=psb_err_iarg_not_gteia_ii_ int_err(1) = 3 int_err(2) = ia int_err(3) = 5 int_err(4) = psb_m_ - int_err(5) = psb_cd_get_global_rows(desc_dec) - else if (psb_cd_get_global_cols(desc_dec) < ja) then + int_err(5) = desc_dec%get_global_rows() + else if (desc_dec%get_global_cols() < ja) then info=psb_err_iarg_not_gteia_ii_ int_err(1) = 4 int_err(2) = ja int_err(3) = 5 int_err(4) = psb_n_ - int_err(5) = psb_cd_get_global_cols(desc_dec) - else if (psb_cd_get_global_rows(desc_dec) < (ia+m-1)) then + int_err(5) = desc_dec%get_global_cols() + else if (desc_dec%get_global_rows() < (ia+m-1)) then info=psb_err_iarg2_neg_ int_err(1) = 1 int_err(2) = m int_err(3) = 3 int_err(4) = ia - else if (psb_cd_get_global_cols(desc_dec) < (ja+n-1)) then + else if (desc_dec%get_global_cols() < (ja+n-1)) then info=psb_err_iarg2_neg_ int_err(1) = 2 int_err(2) = n @@ -411,12 +411,12 @@ contains ! Compute local indices for submatrix starting ! at global indices ix and jx if(present(iia).and.present(jja)) then - if (psb_cd_get_local_rows(desc_dec) > 0) then + if (desc_dec%get_local_rows() > 0) then iia=1 jja=1 else - iia=psb_cd_get_local_rows(desc_dec)+1 - jja=psb_cd_get_local_cols(desc_dec)+1 + iia=desc_dec%get_local_rows()+1 + jja=desc_dec%get_local_cols()+1 end if end if diff --git a/base/modules/psb_comm_mod.f90 b/base/modules/psb_comm_mod.f90 index 21417c56e..4e97acb7a 100644 --- a/base/modules/psb_comm_mod.f90 +++ b/base/modules/psb_comm_mod.f90 @@ -31,401 +31,10 @@ !!$ module psb_comm_mod - interface psb_ovrl - subroutine psb_sovrlm(x,desc_a,info,jx,ik,work,update,mode) - use psb_descriptor_type - real(psb_spk_), intent(inout), target :: x(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - real(psb_spk_), intent(inout), optional, target :: work(:) - integer, intent(in), optional :: update,jx,ik,mode - end subroutine psb_sovrlm - subroutine psb_sovrlv(x,desc_a,info,work,update,mode) - use psb_descriptor_type - real(psb_spk_), intent(inout), target :: x(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - real(psb_spk_), intent(inout), optional, target :: work(:) - integer, intent(in), optional :: update,mode - end subroutine psb_sovrlv - subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update,mode) - use psb_descriptor_type - real(psb_dpk_), intent(inout), target :: x(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - real(psb_dpk_), intent(inout), optional, target :: work(:) - integer, intent(in), optional :: update,jx,ik,mode - end subroutine psb_dovrlm - subroutine psb_dovrlv(x,desc_a,info,work,update,mode) - use psb_descriptor_type - real(psb_dpk_), intent(inout), target :: x(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - real(psb_dpk_), intent(inout), optional, target :: work(:) - integer, intent(in), optional :: update,mode - end subroutine psb_dovrlv - subroutine psb_iovrlm(x,desc_a,info,jx,ik,work,update,mode) - use psb_descriptor_type - integer, intent(inout), target :: x(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - integer, intent(inout), optional, target :: work(:) - integer, intent(in), optional :: update,jx,ik,mode - end subroutine psb_iovrlm - subroutine psb_iovrlv(x,desc_a,info,work,update,mode) - use psb_descriptor_type - integer, intent(inout), target :: x(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - integer, intent(inout), optional, target :: work(:) - integer, intent(in), optional :: update,mode - end subroutine psb_iovrlv - subroutine psb_covrlm(x,desc_a,info,jx,ik,work,update,mode) - use psb_descriptor_type - complex(psb_spk_), intent(inout), target :: x(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - complex(psb_spk_), intent(inout), optional, target :: work(:) - integer, intent(in), optional :: update,jx,ik,mode - end subroutine psb_covrlm - subroutine psb_covrlv(x,desc_a,info,work,update,mode) - use psb_descriptor_type - complex(psb_spk_), intent(inout), target :: x(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - complex(psb_spk_), intent(inout), optional, target :: work(:) - integer, intent(in), optional :: update,mode - end subroutine psb_covrlv - subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,update,mode) - use psb_descriptor_type - complex(psb_dpk_), intent(inout), target :: x(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - complex(psb_dpk_), intent(inout), optional, target :: work(:) - integer, intent(in), optional :: update,jx,ik,mode - end subroutine psb_zovrlm - subroutine psb_zovrlv(x,desc_a,info,work,update,mode) - use psb_descriptor_type - complex(psb_dpk_), intent(inout), target :: x(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - complex(psb_dpk_), intent(inout), optional, target :: work(:) - integer, intent(in), optional :: update,mode - end subroutine psb_zovrlv - end interface - - interface psb_halo - subroutine psb_shalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data) - use psb_descriptor_type - real(psb_spk_), intent(inout),target :: x(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - real(psb_spk_), intent(in), optional :: alpha - real(psb_spk_), target, optional, intent(inout) :: work(:) - integer, intent(in), optional :: mode,jx,ik,data - character, intent(in), optional :: tran - end subroutine psb_shalom - subroutine psb_shalov(x,desc_a,info,alpha,work,tran,mode,data) - use psb_descriptor_type - real(psb_spk_), intent(inout) :: x(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - real(psb_spk_), intent(in), optional :: alpha - real(psb_spk_), target, optional, intent(inout) :: work(:) - integer, intent(in), optional :: mode,data - character, intent(in), optional :: tran - end subroutine psb_shalov - subroutine psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data) - use psb_descriptor_type - real(psb_dpk_), intent(inout),target :: x(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - real(psb_dpk_), intent(in), optional :: alpha - real(psb_dpk_), target, optional, intent(inout) :: work(:) - integer, intent(in), optional :: mode,jx,ik,data - character, intent(in), optional :: tran - end subroutine psb_dhalom - subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode,data) - use psb_descriptor_type - real(psb_dpk_), intent(inout) :: x(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - real(psb_dpk_), intent(in), optional :: alpha - real(psb_dpk_), target, optional, intent(inout) :: work(:) - integer, intent(in), optional :: mode,data - character, intent(in), optional :: tran - end subroutine psb_dhalov - subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data) - use psb_descriptor_type - integer, intent(inout), target :: x(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - real(psb_dpk_), intent(in), optional :: alpha - integer, intent(inout), optional, target :: work(:) - integer, intent(in), optional :: mode,jx,ik,data - character, intent(in), optional :: tran - end subroutine psb_ihalom - subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode,data) - use psb_descriptor_type - integer, intent(inout) :: x(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - real(psb_dpk_), intent(in), optional :: alpha - integer, intent(inout), optional, target :: work(:) - integer, intent(in), optional :: mode,data - character, intent(in), optional :: tran - end subroutine psb_ihalov - subroutine psb_chalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data) - use psb_descriptor_type - complex(psb_spk_), intent(inout), target :: x(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - complex(psb_spk_), intent(in), optional :: alpha - complex(psb_spk_), target, optional, intent(inout) :: work(:) - integer, intent(in), optional :: mode,jx,ik,data - character, intent(in), optional :: tran - end subroutine psb_chalom - subroutine psb_chalov(x,desc_a,info,alpha,work,tran,mode,data) - use psb_descriptor_type - complex(psb_spk_), intent(inout) :: x(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - complex(psb_spk_), intent(in), optional :: alpha - complex(psb_spk_), target, optional, intent(inout) :: work(:) - integer, intent(in), optional :: mode,data - character, intent(in), optional :: tran - end subroutine psb_chalov - subroutine psb_zhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data) - use psb_descriptor_type - complex(psb_dpk_), intent(inout), target :: x(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - complex(psb_dpk_), intent(in), optional :: alpha - complex(psb_dpk_), target, optional, intent(inout) :: work(:) - integer, intent(in), optional :: mode,jx,ik,data - character, intent(in), optional :: tran - end subroutine psb_zhalom - subroutine psb_zhalov(x,desc_a,info,alpha,work,tran,mode,data) - use psb_descriptor_type - complex(psb_dpk_), intent(inout) :: x(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - complex(psb_dpk_), intent(in), optional :: alpha - complex(psb_dpk_), target, optional, intent(inout) :: work(:) - integer, intent(in), optional :: mode,data - character, intent(in), optional :: tran - end subroutine psb_zhalov - end interface - - - interface psb_scatter - subroutine psb_dscatterm(globx, locx, desc_a, info, root) - use psb_descriptor_type - real(psb_dpk_), intent(out) :: locx(:,:) - real(psb_dpk_), intent(in) :: globx(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - integer, intent(in), optional :: root - end subroutine psb_dscatterm - subroutine psb_dscatterv(globx, locx, desc_a, info, root) - use psb_descriptor_type - real(psb_dpk_), intent(out) :: locx(:) - real(psb_dpk_), intent(in) :: globx(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - integer, intent(in), optional :: root - end subroutine psb_dscatterv - subroutine psb_zscatterm(globx, locx, desc_a, info, root) - use psb_descriptor_type - complex(psb_dpk_), intent(out) :: locx(:,:) - complex(psb_dpk_), intent(in) :: globx(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - integer, intent(in), optional :: root - end subroutine psb_zscatterm - subroutine psb_zscatterv(globx, locx, desc_a, info, root) - use psb_descriptor_type - complex(psb_dpk_), intent(out) :: locx(:) - complex(psb_dpk_), intent(in) :: globx(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - integer, intent(in), optional :: root - end subroutine psb_zscatterv - subroutine psb_iscatterm(globx, locx, desc_a, info, root) - use psb_descriptor_type - integer, intent(out) :: locx(:,:) - integer, intent(in) :: globx(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - integer, intent(in), optional :: root - end subroutine psb_iscatterm - subroutine psb_iscatterv(globx, locx, desc_a, info, root) - use psb_descriptor_type - integer, intent(out) :: locx(:) - integer, intent(in) :: globx(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - integer, intent(in), optional :: root - end subroutine psb_iscatterv - subroutine psb_sscatterm(globx, locx, desc_a, info, root) - use psb_descriptor_type - real(psb_spk_), intent(out) :: locx(:,:) - real(psb_spk_), intent(in) :: globx(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - integer, intent(in), optional :: root - end subroutine psb_sscatterm - subroutine psb_sscatterv(globx, locx, desc_a, info, root) - use psb_descriptor_type - real(psb_spk_), intent(out) :: locx(:) - real(psb_spk_), intent(in) :: globx(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - integer, intent(in), optional :: root - end subroutine psb_sscatterv - subroutine psb_cscatterm(globx, locx, desc_a, info, root) - use psb_descriptor_type - complex(psb_spk_), intent(out) :: locx(:,:) - complex(psb_spk_), intent(in) :: globx(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - integer, intent(in), optional :: root - end subroutine psb_cscatterm - subroutine psb_cscatterv(globx, locx, desc_a, info, root) - use psb_descriptor_type - complex(psb_spk_), intent(out) :: locx(:) - complex(psb_spk_), intent(in) :: globx(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - integer, intent(in), optional :: root - end subroutine psb_cscatterv - end interface - - interface psb_gather - subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) - use psb_descriptor_type - use psb_mat_mod - implicit none - type(psb_dspmat_type), intent(inout) :: loca - type(psb_dspmat_type), intent(out) :: globa - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - integer, intent(in), optional :: root,dupl - logical, intent(in), optional :: keepnum,keeploc - end subroutine psb_dsp_allgather - subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) - use psb_descriptor_type - use psb_mat_mod - implicit none - type(psb_sspmat_type), intent(inout) :: loca - type(psb_sspmat_type), intent(out) :: globa - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - integer, intent(in), optional :: root,dupl - logical, intent(in), optional :: keepnum,keeploc - end subroutine psb_ssp_allgather - subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) - use psb_descriptor_type - use psb_mat_mod - implicit none - type(psb_zspmat_type), intent(inout) :: loca - type(psb_zspmat_type), intent(out) :: globa - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - integer, intent(in), optional :: root,dupl - logical, intent(in), optional :: keepnum,keeploc - end subroutine psb_zsp_allgather - subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) - use psb_descriptor_type - use psb_mat_mod - implicit none - type(psb_cspmat_type), intent(inout) :: loca - type(psb_cspmat_type), intent(out) :: globa - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - integer, intent(in), optional :: root,dupl - logical, intent(in), optional :: keepnum,keeploc - end subroutine psb_csp_allgather - subroutine psb_igatherm(globx, locx, desc_a, info, root) - use psb_descriptor_type - integer, intent(in) :: locx(:,:) - integer, intent(out) :: globx(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - integer, intent(in), optional :: root - end subroutine psb_igatherm - subroutine psb_igatherv(globx, locx, desc_a, info, root) - use psb_descriptor_type - integer, intent(in) :: locx(:) - integer, intent(out) :: globx(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - integer, intent(in), optional :: root - end subroutine psb_igatherv - subroutine psb_sgatherm(globx, locx, desc_a, info, root) - use psb_descriptor_type - real(psb_spk_), intent(in) :: locx(:,:) - real(psb_spk_), intent(out) :: globx(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - integer, intent(in), optional :: root - end subroutine psb_sgatherm - subroutine psb_sgatherv(globx, locx, desc_a, info, root) - use psb_descriptor_type - real(psb_spk_), intent(in) :: locx(:) - real(psb_spk_), intent(out) :: globx(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - integer, intent(in), optional :: root - end subroutine psb_sgatherv - subroutine psb_dgatherm(globx, locx, desc_a, info, root) - use psb_descriptor_type - real(psb_dpk_), intent(in) :: locx(:,:) - real(psb_dpk_), intent(out) :: globx(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - integer, intent(in), optional :: root - end subroutine psb_dgatherm - subroutine psb_dgatherv(globx, locx, desc_a, info, root) - use psb_descriptor_type - real(psb_dpk_), intent(in) :: locx(:) - real(psb_dpk_), intent(out) :: globx(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - integer, intent(in), optional :: root - end subroutine psb_dgatherv - subroutine psb_cgatherm(globx, locx, desc_a, info, root) - use psb_descriptor_type - complex(psb_spk_), intent(in) :: locx(:,:) - complex(psb_spk_), intent(out) :: globx(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - integer, intent(in), optional :: root - end subroutine psb_cgatherm - subroutine psb_cgatherv(globx, locx, desc_a, info, root) - use psb_descriptor_type - complex(psb_spk_), intent(in) :: locx(:) - complex(psb_spk_), intent(out) :: globx(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - integer, intent(in), optional :: root - end subroutine psb_cgatherv - subroutine psb_zgatherm(globx, locx, desc_a, info, root) - use psb_descriptor_type - complex(psb_dpk_), intent(in) :: locx(:,:) - complex(psb_dpk_), intent(out) :: globx(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - integer, intent(in), optional :: root - end subroutine psb_zgatherm - subroutine psb_zgatherv(globx, locx, desc_a, info, root) - use psb_descriptor_type - complex(psb_dpk_), intent(in) :: locx(:) - complex(psb_dpk_), intent(out) :: globx(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - integer, intent(in), optional :: root - end subroutine psb_zgatherv - end interface + use psb_i_comm_mod + use psb_s_comm_mod + use psb_d_comm_mod + use psb_c_comm_mod + use psb_z_comm_mod end module psb_comm_mod diff --git a/base/modules/psb_const_mod.F90 b/base/modules/psb_const_mod.F90 index d26515ce3..c86534e46 100644 --- a/base/modules/psb_const_mod.F90 +++ b/base/modules/psb_const_mod.F90 @@ -181,6 +181,7 @@ module psb_const_mod integer, parameter, public :: psb_err_invalid_mat_state_=1121 integer, parameter, public :: psb_err_invalid_cd_state_=1122 integer, parameter, public :: psb_err_invalid_a_and_cd_state_=1123 + integer, parameter, public :: psb_err_invalid_vect_state_=1124 integer, parameter, public :: psb_err_context_error_=2010 integer, parameter, public :: psb_err_initerror_neugh_procs_=2011 integer, parameter, public :: psb_err_invalid_matrix_input_state_=2231 diff --git a/base/modules/psb_d_base_mat_mod.f90 b/base/modules/psb_d_base_mat_mod.f90 index c5d827e25..a84b4e998 100644 --- a/base/modules/psb_d_base_mat_mod.f90 +++ b/base/modules/psb_d_base_mat_mod.f90 @@ -58,21 +58,26 @@ module psb_d_base_mat_mod use psb_base_mat_mod + use psb_d_base_vect_mod type, extends(psb_base_sparse_mat) :: psb_d_base_sparse_mat contains + procedure, pass(a) :: d_sp_mv => psb_d_base_vect_mv procedure, pass(a) :: d_csmv => psb_d_base_csmv procedure, pass(a) :: d_csmm => psb_d_base_csmm - generic, public :: csmm => d_csmm, d_csmv + generic, public :: csmm => d_csmm, d_csmv, d_sp_mv + procedure, pass(a) :: d_in_sv => psb_d_base_inner_vect_sv procedure, pass(a) :: d_inner_cssv => psb_d_base_inner_cssv procedure, pass(a) :: d_inner_cssm => psb_d_base_inner_cssm - generic, public :: inner_cssm => d_inner_cssm, d_inner_cssv + generic, public :: inner_cssm => d_inner_cssm, d_inner_cssv, d_in_sv + procedure, pass(a) :: d_vect_cssv => psb_d_base_vect_cssv procedure, pass(a) :: d_cssv => psb_d_base_cssv procedure, pass(a) :: d_cssm => psb_d_base_cssm - generic, public :: cssm => d_cssm, d_cssv + generic, public :: cssm => d_cssm, d_cssv, d_vect_cssv procedure, pass(a) :: d_scals => psb_d_base_scals procedure, pass(a) :: d_scal => psb_d_base_scal generic, public :: scal => d_scals, d_scal + procedure, pass(a) :: maxval => psb_d_base_maxval procedure, pass(a) :: csnmi => psb_d_base_csnmi procedure, pass(a) :: csnm1 => psb_d_base_csnm1 procedure, pass(a) :: rowsum => psb_d_base_rowsum @@ -140,6 +145,7 @@ module psb_d_base_mat_mod procedure, pass(a) :: mv_to_fmt => psb_d_mv_coo_to_fmt procedure, pass(a) :: mv_from_fmt => psb_d_mv_coo_from_fmt procedure, pass(a) :: csput => psb_d_coo_csput + procedure, pass(a) :: maxval => psb_d_coo_maxval procedure, pass(a) :: csnmi => psb_d_coo_csnmi procedure, pass(a) :: csnm1 => psb_d_coo_csnm1 procedure, pass(a) :: rowsum => psb_d_coo_rowsum @@ -200,6 +206,18 @@ module psb_d_base_mat_mod end subroutine psb_d_base_csmv end interface + interface + subroutine psb_d_base_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_d_base_sparse_mat, psb_dpk_, psb_d_base_vect_type + class(psb_d_base_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta + class(psb_d_base_vect_type), intent(inout) :: x + class(psb_d_base_vect_type), intent(inout) :: y + integer, intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_base_vect_mv + end interface + interface subroutine psb_d_base_inner_cssm(alpha,a,x,beta,y,info,trans) import :: psb_d_base_sparse_mat, psb_dpk_ @@ -222,6 +240,17 @@ module psb_d_base_mat_mod end subroutine psb_d_base_inner_cssv end interface + interface + subroutine psb_d_base_inner_vect_sv(alpha,a,x,beta,y,info,trans) + import :: psb_d_base_sparse_mat, psb_dpk_, psb_d_base_vect_type + class(psb_d_base_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta + class(psb_d_base_vect_type), intent(inout) :: x, y + integer, intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_base_inner_vect_sv + end interface + interface subroutine psb_d_base_cssm(alpha,a,x,beta,y,info,trans,scale,d) import :: psb_d_base_sparse_mat, psb_dpk_ @@ -246,6 +275,18 @@ module psb_d_base_mat_mod end subroutine psb_d_base_cssv end interface + interface + subroutine psb_d_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d) + import :: psb_d_base_sparse_mat, psb_dpk_,psb_d_base_vect_type + class(psb_d_base_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta + class(psb_d_base_vect_type), intent(inout) :: x,y + integer, intent(out) :: info + character, optional, intent(in) :: trans, scale + class(psb_d_base_vect_type), optional, intent(inout) :: d + end subroutine psb_d_base_vect_cssv + end interface + interface subroutine psb_d_base_scals(d,a,info) import :: psb_d_base_sparse_mat, psb_dpk_ @@ -264,6 +305,14 @@ module psb_d_base_mat_mod end subroutine psb_d_base_scal end interface + interface + function psb_d_base_maxval(a) result(res) + import :: psb_d_base_sparse_mat, psb_dpk_ + class(psb_d_base_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + end function psb_d_base_maxval + end interface + interface function psb_d_base_csnmi(a) result(res) import :: psb_d_base_sparse_mat, psb_dpk_ @@ -755,7 +804,15 @@ module psb_d_base_mat_mod end subroutine psb_d_coo_csmm end interface - + + interface + function psb_d_coo_maxval(a) result(res) + import :: psb_d_coo_sparse_mat, psb_dpk_ + class(psb_d_coo_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + end function psb_d_coo_maxval + end interface + interface function psb_d_coo_csnmi(a) result(res) import :: psb_d_coo_sparse_mat, psb_dpk_ @@ -804,7 +861,6 @@ module psb_d_base_mat_mod end subroutine psb_d_coo_aclsum end interface - interface subroutine psb_d_coo_get_diag(a,d,info) import :: psb_d_coo_sparse_mat, psb_dpk_ @@ -965,7 +1021,6 @@ contains ! ! == ================================== - subroutine d_coo_free(a) implicit none diff --git a/base/modules/psb_d_base_vect_mod.f90 b/base/modules/psb_d_base_vect_mod.f90 new file mode 100644 index 000000000..1a4b12bdd --- /dev/null +++ b/base/modules/psb_d_base_vect_mod.f90 @@ -0,0 +1,565 @@ +module psb_d_base_vect_mod + + use psb_const_mod + use psb_error_mod + + type psb_d_base_vect_type + real(psb_dpk_), allocatable :: v(:) + contains + procedure, pass(x) :: get_nrows => d_base_get_nrows + procedure, pass(x) :: dot_v => d_base_dot_v + procedure, pass(x) :: dot_a => d_base_dot_a + generic, public :: dot => dot_v, dot_a + procedure, pass(y) :: axpby_v => d_base_axpby_v + procedure, pass(y) :: axpby_a => d_base_axpby_a + generic, public :: axpby => axpby_v, axpby_a + procedure, pass(y) :: mlt_v => d_base_mlt_v + procedure, pass(y) :: mlt_a => d_base_mlt_a + procedure, pass(z) :: mlt_a_2 => d_base_mlt_a_2 + procedure, pass(z) :: mlt_v_2 => d_base_mlt_v_2 + procedure, pass(z) :: mlt_va => d_base_mlt_va + procedure, pass(z) :: mlt_av => d_base_mlt_av + generic, public :: mlt => mlt_v, mlt_a, mlt_a_2, mlt_v_2, mlt_av, mlt_va + procedure, pass(x) :: scal => d_base_scal + procedure, pass(x) :: nrm2 => d_base_nrm2 + procedure, pass(x) :: amax => d_base_amax + procedure, pass(x) :: asum => d_base_asum + procedure, pass(x) :: all => d_base_all + procedure, pass(x) :: zero => d_base_zero + procedure, pass(x) :: asb => d_base_asb + procedure, pass(x) :: sync => d_base_sync + procedure, pass(x) :: gthab => d_base_gthab + procedure, pass(x) :: gthzv => d_base_gthzv + generic, public :: gth => gthab, gthzv + procedure, pass(y) :: sctb => d_base_sctb + generic, public :: sct => sctb + procedure, pass(x) :: free => d_base_free + procedure, pass(x) :: ins => d_base_ins + procedure, pass(x) :: bld_x => d_base_bld_x + procedure, pass(x) :: bld_n => d_base_bld_n + generic, public :: bld => bld_x, bld_n + procedure, pass(x) :: getCopy => d_base_getCopy + procedure, pass(x) :: cpy_vect => d_base_cpy_vect + generic, public :: assignment(=) => cpy_vect, set_scal + procedure, pass(x) :: set_scal => d_base_set_scal + procedure, pass(x) :: set_vect => d_base_set_vect + generic, public :: set => set_vect, set_scal + end type psb_d_base_vect_type + + public :: psb_d_base_vect + private :: constructor, size_const + interface psb_d_base_vect + module procedure constructor, size_const + end interface psb_d_base_vect + +contains + + subroutine d_base_bld_x(x,this) + use psb_realloc_mod + real(psb_dpk_), intent(in) :: this(:) + class(psb_d_base_vect_type), intent(inout) :: x + integer :: info + + call psb_realloc(size(this),x%v,info) + if (info /= 0) then + call psb_errpush(psb_err_alloc_dealloc_,'base_vect_bld') + return + end if + x%v(:) = this(:) + + end subroutine d_base_bld_x + + + subroutine d_base_bld_n(x,n) + integer, intent(in) :: n + class(psb_d_base_vect_type), intent(inout) :: x + integer :: info + + call x%asb(n,info) + + end subroutine d_base_bld_n + + function d_base_getCopy(x) result(res) + class(psb_d_base_vect_type), intent(in) :: x + real(psb_dpk_), allocatable :: res(:) + integer :: info + + allocate(res(x%get_nrows()),stat=info) + if (info /= 0) then + call psb_errpush(psb_err_alloc_dealloc_,'base_getCopy') + return + end if + res(:) = x%v(:) + end function d_base_getCopy + + subroutine d_base_cpy_vect(res,x) + real(psb_dpk_), allocatable, intent(out) :: res(:) + class(psb_d_base_vect_type), intent(in) :: x + integer :: info + + res = x%v + + end subroutine d_base_cpy_vect + + subroutine d_base_set_scal(x,val) + class(psb_d_base_vect_type), intent(inout) :: x + real(psb_dpk_), intent(in) :: val + + integer :: info + x%v = val + + end subroutine d_base_set_scal + + subroutine d_base_set_vect(x,val) + class(psb_d_base_vect_type), intent(inout) :: x + real(psb_dpk_), intent(in) :: val(:) + + integer :: info + x%v = val + + end subroutine d_base_set_vect + + + function constructor(x) result(this) + real(psb_dpk_) :: x(:) + type(psb_d_base_vect_type) :: this + integer :: info + + this%v = x + call this%asb(size(x),info) + end function constructor + + + function size_const(n) result(this) + integer, intent(in) :: n + type(psb_d_base_vect_type) :: this + integer :: info + + call this%asb(n,info) + + end function size_const + + + function d_base_get_nrows(x) result(res) + implicit none + class(psb_d_base_vect_type), intent(in) :: x + integer :: res + res = -1 + if (allocated(x%v)) res = size(x%v) + end function d_base_get_nrows + + function d_base_dot_v(n,x,y) result(res) + implicit none + class(psb_d_base_vect_type), intent(inout) :: x, y + integer, intent(in) :: n + real(psb_dpk_) :: res + real(psb_dpk_), external :: ddot + + res = dzero + ! + ! Note: this is the base implementation. + ! When we get here, we are sure that X is of + ! TYPE psb_d_base_vect + ! + select type(yy => y) + type is (psb_d_base_vect_type) + res = ddot(n,x%v,1,y%v,1) + class default + res = y%dot(n,x%v) + end select + + end function d_base_dot_v + + function d_base_dot_a(n,x,y) result(res) + implicit none + class(psb_d_base_vect_type), intent(inout) :: x + real(psb_dpk_), intent(in) :: y(:) + integer, intent(in) :: n + real(psb_dpk_) :: res + real(psb_dpk_), external :: ddot + + res = ddot(n,y,1,x%v,1) + + end function d_base_dot_a + + subroutine d_base_axpby_v(m,alpha, x, beta, y, info) + use psi_serial_mod + implicit none + integer, intent(in) :: m + class(psb_d_base_vect_type), intent(inout) :: x + class(psb_d_base_vect_type), intent(inout) :: y + real(psb_dpk_), intent (in) :: alpha, beta + integer, intent(out) :: info + + select type(xx => x) + type is (psb_d_base_vect_type) + call psb_geaxpby(m,alpha,x%v,beta,y%v,info) + class default + call y%axpby(m,alpha,x%v,beta,info) + end select + + end subroutine d_base_axpby_v + + subroutine d_base_axpby_a(m,alpha, x, beta, y, info) + use psi_serial_mod + implicit none + integer, intent(in) :: m + real(psb_dpk_), intent(in) :: x(:) + class(psb_d_base_vect_type), intent(inout) :: y + real(psb_dpk_), intent (in) :: alpha, beta + integer, intent(out) :: info + + call psb_geaxpby(m,alpha,x,beta,y%v,info) + + end subroutine d_base_axpby_a + + + subroutine d_base_mlt_v(x, y, info) + use psi_serial_mod + implicit none + class(psb_d_base_vect_type), intent(inout) :: x + class(psb_d_base_vect_type), intent(inout) :: y + integer, intent(out) :: info + integer :: i, n + + info = 0 + select type(xx => x) + type is (psb_d_base_vect_type) + n = min(size(y%v), size(xx%v)) + do i=1, n + y%v(i) = y%v(i)*xx%v(i) + end do + class default + call y%mlt(x%v,info) + end select + + end subroutine d_base_mlt_v + + subroutine d_base_mlt_a(x, y, info) + use psi_serial_mod + implicit none + real(psb_dpk_), intent(in) :: x(:) + class(psb_d_base_vect_type), intent(inout) :: y + integer, intent(out) :: info + integer :: i, n + + info = 0 + n = min(size(y%v), size(x)) + do i=1, n + y%v(i) = y%v(i)*x(i) + end do + + end subroutine d_base_mlt_a + + + subroutine d_base_mlt_a_2(alpha,x,y,beta,z,info) + use psi_serial_mod + implicit none + real(psb_dpk_), intent(in) :: alpha,beta + real(psb_dpk_), intent(in) :: y(:) + real(psb_dpk_), intent(in) :: x(:) + class(psb_d_base_vect_type), intent(inout) :: z + integer, intent(out) :: info + integer :: i, n + + info = 0 + n = min(size(z%v), size(x), size(y)) +!!$ write(0,*) 'Mlt_a_2: ',n + if (alpha == dzero) then + if (beta == done) then + return + else + do i=1, n + z%v(i) = beta*z%v(i) + end do + end if + else + if (alpha == done) then + if (beta == dzero) then + do i=1, n + z%v(i) = y(i)*x(i) + end do + else if (beta == done) then + do i=1, n + z%v(i) = z%v(i) + y(i)*x(i) + end do + else + do i=1, n + z%v(i) = beta*z%v(i) + y(i)*x(i) + end do + end if + else if (alpha == -done) then + if (beta == dzero) then + do i=1, n + z%v(i) = -y(i)*x(i) + end do + else if (beta == done) then + do i=1, n + z%v(i) = z%v(i) - y(i)*x(i) + end do + else + do i=1, n + z%v(i) = beta*z%v(i) - y(i)*x(i) + end do + end if + else + if (beta == dzero) then + do i=1, n + z%v(i) = alpha*y(i)*x(i) + end do + else if (beta == done) then + do i=1, n + z%v(i) = z%v(i) + alpha*y(i)*x(i) + end do + else + do i=1, n + z%v(i) = beta*z%v(i) + alpha*y(i)*x(i) + end do + end if + end if + end if + end subroutine d_base_mlt_a_2 + + subroutine d_base_mlt_v_2(alpha,x,y,beta,z,info) + use psi_serial_mod + implicit none + real(psb_dpk_), intent(in) :: alpha,beta + class(psb_d_base_vect_type), intent(inout) :: x + class(psb_d_base_vect_type), intent(inout) :: y + class(psb_d_base_vect_type), intent(inout) :: z + integer, intent(out) :: info + integer :: i, n + + info = 0 + + call z%mlt(alpha,x%v,y%v,beta,info) + + end subroutine d_base_mlt_v_2 + + subroutine d_base_mlt_av(alpha,x,y,beta,z,info) + use psi_serial_mod + implicit none + real(psb_dpk_), intent(in) :: alpha,beta + real(psb_dpk_), intent(in) :: x(:) + class(psb_d_base_vect_type), intent(inout) :: y + class(psb_d_base_vect_type), intent(inout) :: z + integer, intent(out) :: info + integer :: i, n + + info = 0 + + call z%mlt(alpha,x,y%v,beta,info) + + end subroutine d_base_mlt_av + + subroutine d_base_mlt_va(alpha,x,y,beta,z,info) + use psi_serial_mod + implicit none + real(psb_dpk_), intent(in) :: alpha,beta + real(psb_dpk_), intent(in) :: y(:) + class(psb_d_base_vect_type), intent(inout) :: x + class(psb_d_base_vect_type), intent(inout) :: z + integer, intent(out) :: info + integer :: i, n + + info = 0 + + call z%mlt(alpha,y,x,beta,info) + + end subroutine d_base_mlt_va + + subroutine d_base_scal(alpha, x) + use psi_serial_mod + implicit none + class(psb_d_base_vect_type), intent(inout) :: x + real(psb_dpk_), intent (in) :: alpha + + if (allocated(x%v)) x%v = alpha*x%v + + end subroutine d_base_scal + + + function d_base_nrm2(n,x) result(res) + implicit none + class(psb_d_base_vect_type), intent(inout) :: x + integer, intent(in) :: n + real(psb_dpk_) :: res + real(psb_dpk_), external :: dnrm2 + + res = dnrm2(n,x%v,1) + + end function d_base_nrm2 + + function d_base_amax(n,x) result(res) + implicit none + class(psb_d_base_vect_type), intent(inout) :: x + integer, intent(in) :: n + real(psb_dpk_) :: res + + res = maxval(abs(x%v(1:n))) + + end function d_base_amax + + function d_base_asum(n,x) result(res) + implicit none + class(psb_d_base_vect_type), intent(inout) :: x + integer, intent(in) :: n + real(psb_dpk_) :: res + + res = sum(abs(x%v(1:n))) + + end function d_base_asum + + subroutine d_base_all(n, x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + integer, intent(in) :: n + class(psb_d_base_vect_type), intent(out) :: x + integer, intent(out) :: info + + call psb_realloc(n,x%v,info) + + end subroutine d_base_all + + subroutine d_base_zero(x) + use psi_serial_mod + implicit none + class(psb_d_base_vect_type), intent(inout) :: x + + if (allocated(x%v)) x%v=dzero + + end subroutine d_base_zero + + subroutine d_base_asb(n, x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + integer, intent(in) :: n + class(psb_d_base_vect_type), intent(inout) :: x + integer, intent(out) :: info + + if (x%get_nrows() < n) & + & call psb_realloc(n,x%v,info) + if (info /= 0) & + & call psb_errpush(psb_err_alloc_dealloc_,'vect_asb') + + end subroutine d_base_asb + + subroutine d_base_sync(x) + implicit none + class(psb_d_base_vect_type), intent(inout) :: x + + ! + ! The base version does nothing, it's just + ! a placeholder. + ! + + end subroutine d_base_sync + + subroutine d_base_gthab(n,idx,alpha,x,beta,y) + use psi_serial_mod + integer :: n, idx(:) + real(psb_dpk_) :: alpha, beta, y(:) + class(psb_d_base_vect_type) :: x + + call x%sync() + call psi_gth(n,idx,alpha,x%v,beta,y) + + end subroutine d_base_gthab + + subroutine d_base_gthzv(n,idx,x,y) + use psi_serial_mod + integer :: n, idx(:) + real(psb_dpk_) :: y(:) + class(psb_d_base_vect_type) :: x + + call x%sync() + call psi_gth(n,idx,x%v,y) + + end subroutine d_base_gthzv + + subroutine d_base_sctb(n,idx,x,beta,y) + use psi_serial_mod + integer :: n, idx(:) + real(psb_dpk_) :: beta, x(:) + class(psb_d_base_vect_type) :: y + + call y%sync() + call psi_sct(n,idx,x,beta,y%v) + + end subroutine d_base_sctb + + subroutine d_base_free(x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + class(psb_d_base_vect_type), intent(inout) :: x + integer, intent(out) :: info + + info = 0 + if (allocated(x%v)) deallocate(x%v, stat=info) + if (info /= 0) call & + & psb_errpush(psb_err_alloc_dealloc_,'vect_free') + + end subroutine d_base_free + + subroutine d_base_ins(n,irl,val,dupl,x,info) + use psi_serial_mod + implicit none + class(psb_d_base_vect_type), intent(inout) :: x + integer, intent(in) :: n, dupl + integer, intent(in) :: irl(:) + real(psb_dpk_), intent(in) :: val(:) + integer, intent(out) :: info + + integer :: i + + info = 0 + if (psb_errstatus_fatal()) return + + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + else if (n > min(size(irl),size(val))) then + info = psb_err_invalid_input_ + + else + select case(dupl) + case(psb_dupl_ovwrt_) + do i = 1, n + !loop over all val's rows + + ! row actual block row + if (irl(i) > 0) then + ! this row belongs to me + ! copy i-th row of block val in x + x%v(irl(i)) = val(i) + end if + enddo + + case(psb_dupl_add_) + + do i = 1, n + !loop over all val's rows + + if (irl(i) > 0) then + ! this row belongs to me + ! copy i-th row of block val in x + x%v(irl(i)) = x%v(irl(i)) + val(i) + end if + enddo + + case default + info = 321 +!!$ call psb_errpush(info,name) +!!$ goto 9999 + end select + end if + if (info /= 0) then + call psb_errpush(info,'base_vect_ins') + return + end if + + end subroutine d_base_ins + +end module psb_d_base_vect_mod diff --git a/base/modules/psb_d_comm_mod.f90 b/base/modules/psb_d_comm_mod.f90 new file mode 100644 index 000000000..e78430949 --- /dev/null +++ b/base/modules/psb_d_comm_mod.f90 @@ -0,0 +1,155 @@ +!!$ +!!$ Parallel Sparse BLAS version 3.0 +!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +module psb_d_comm_mod + + interface psb_ovrl + subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update,mode) + use psb_descriptor_type + real(psb_dpk_), intent(inout), target :: x(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + real(psb_dpk_), intent(inout), optional, target :: work(:) + integer, intent(in), optional :: update,jx,ik,mode + end subroutine psb_dovrlm + subroutine psb_dovrlv(x,desc_a,info,work,update,mode) + use psb_descriptor_type + real(psb_dpk_), intent(inout), target :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + real(psb_dpk_), intent(inout), optional, target :: work(:) + integer, intent(in), optional :: update,mode + end subroutine psb_dovrlv + subroutine psb_dovrl_vect(x,desc_a,info,work,update,mode) + use psb_descriptor_type + use psb_d_vect_mod + type(psb_d_vect_type), intent(inout) :: x + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + real(psb_dpk_), intent(inout), optional, target :: work(:) + integer, intent(in), optional :: update,mode + end subroutine psb_dovrl_vect + end interface + + interface psb_halo + subroutine psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data) + use psb_descriptor_type + real(psb_dpk_), intent(inout),target :: x(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + real(psb_dpk_), intent(in), optional :: alpha + real(psb_dpk_), target, optional, intent(inout) :: work(:) + integer, intent(in), optional :: mode,jx,ik,data + character, intent(in), optional :: tran + end subroutine psb_dhalom + subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode,data) + use psb_descriptor_type + real(psb_dpk_), intent(inout) :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + real(psb_dpk_), intent(in), optional :: alpha + real(psb_dpk_), target, optional, intent(inout) :: work(:) + integer, intent(in), optional :: mode,data + character, intent(in), optional :: tran + end subroutine psb_dhalov + subroutine psb_dhalo_vect(x,desc_a,info,alpha,work,tran,mode,data) + use psb_descriptor_type + use psb_d_vect_mod + type(psb_d_vect_type), intent(inout) :: x + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + real(psb_dpk_), intent(in), optional :: alpha + real(psb_dpk_), target, optional, intent(inout) :: work(:) + integer, intent(in), optional :: mode,data + character, intent(in), optional :: tran + end subroutine psb_dhalo_vect + end interface + + + interface psb_scatter + subroutine psb_dscatterm(globx, locx, desc_a, info, root) + use psb_descriptor_type + real(psb_dpk_), intent(out) :: locx(:,:) + real(psb_dpk_), intent(in) :: globx(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, intent(in), optional :: root + end subroutine psb_dscatterm + subroutine psb_dscatterv(globx, locx, desc_a, info, root) + use psb_descriptor_type + real(psb_dpk_), intent(out) :: locx(:) + real(psb_dpk_), intent(in) :: globx(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, intent(in), optional :: root + end subroutine psb_dscatterv + end interface + + interface psb_gather + subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) + use psb_descriptor_type + use psb_mat_mod + implicit none + type(psb_dspmat_type), intent(inout) :: loca + type(psb_dspmat_type), intent(out) :: globa + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, intent(in), optional :: root,dupl + logical, intent(in), optional :: keepnum,keeploc + end subroutine psb_dsp_allgather + subroutine psb_dgatherm(globx, locx, desc_a, info, root) + use psb_descriptor_type + real(psb_dpk_), intent(in) :: locx(:,:) + real(psb_dpk_), intent(out) :: globx(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, intent(in), optional :: root + end subroutine psb_dgatherm + subroutine psb_dgatherv(globx, locx, desc_a, info, root) + use psb_descriptor_type + real(psb_dpk_), intent(in) :: locx(:) + real(psb_dpk_), intent(out) :: globx(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, intent(in), optional :: root + end subroutine psb_dgatherv + subroutine psb_dgather_vect(globx, locx, desc_a, info, root) + use psb_descriptor_type + use psb_d_vect_mod + type(psb_d_vect_type), intent(in) :: locx + real(psb_dpk_), intent(out) :: globx(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, intent(in), optional :: root + end subroutine psb_dgather_vect + end interface + +end module psb_d_comm_mod diff --git a/base/modules/psb_d_csc_mat_mod.f90 b/base/modules/psb_d_csc_mat_mod.f90 index 3d1a01e10..35a8ad67a 100644 --- a/base/modules/psb_d_csc_mat_mod.f90 +++ b/base/modules/psb_d_csc_mat_mod.f90 @@ -58,6 +58,7 @@ module psb_d_csc_mat_mod procedure, pass(a) :: d_inner_cssv => psb_d_csc_cssv procedure, pass(a) :: d_scals => psb_d_csc_scals procedure, pass(a) :: d_scal => psb_d_csc_scal + procedure, pass(a) :: maxval => psb_d_csc_maxval procedure, pass(a) :: csnmi => psb_d_csc_csnmi procedure, pass(a) :: csnm1 => psb_d_csc_csnm1 procedure, pass(a) :: rowsum => psb_d_csc_rowsum @@ -335,6 +336,14 @@ module psb_d_csc_mat_mod end interface + interface + function psb_d_csc_maxval(a) result(res) + import :: psb_d_csc_sparse_mat, psb_dpk_ + class(psb_d_csc_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + end function psb_d_csc_maxval + end interface + interface function psb_d_csc_csnmi(a) result(res) import :: psb_d_csc_sparse_mat, psb_dpk_ diff --git a/base/modules/psb_d_csr_mat_mod.f90 b/base/modules/psb_d_csr_mat_mod.f90 index 66a9f9338..294b56950 100644 --- a/base/modules/psb_d_csr_mat_mod.f90 +++ b/base/modules/psb_d_csr_mat_mod.f90 @@ -58,6 +58,7 @@ module psb_d_csr_mat_mod procedure, pass(a) :: d_inner_cssv => psb_d_csr_cssv procedure, pass(a) :: d_scals => psb_d_csr_scals procedure, pass(a) :: d_scal => psb_d_csr_scal + procedure, pass(a) :: maxval => psb_d_csr_maxval procedure, pass(a) :: csnmi => psb_d_csr_csnmi procedure, pass(a) :: csnm1 => psb_d_csr_csnm1 procedure, pass(a) :: rowsum => psb_d_csr_rowsum @@ -335,6 +336,14 @@ module psb_d_csr_mat_mod end interface + interface + function psb_d_csr_maxval(a) result(res) + import :: psb_d_csr_sparse_mat, psb_dpk_ + class(psb_d_csr_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + end function psb_d_csr_maxval + end interface + interface function psb_d_csr_csnmi(a) result(res) import :: psb_d_csr_sparse_mat, psb_dpk_ diff --git a/base/modules/psb_d_linmap_mod.f90 b/base/modules/psb_d_linmap_mod.f90 index 9c2e75368..6bbc724fb 100644 --- a/base/modules/psb_d_linmap_mod.f90 +++ b/base/modules/psb_d_linmap_mod.f90 @@ -52,6 +52,16 @@ module psb_d_linmap_mod integer, intent(out) :: info real(psb_dpk_), optional :: work(:) end subroutine psb_d_map_X2Y + subroutine psb_d_map_X2Y_vect(alpha,x,beta,y,map,info,work) + use psb_d_vect_mod + use psb_linmap_type_mod + implicit none + type(psb_dlinmap_type), intent(in) :: map + real(psb_dpk_), intent(in) :: alpha,beta + type(psb_d_vect_type), intent(inout) :: x,y + integer, intent(out) :: info + real(psb_dpk_), optional :: work(:) + end subroutine psb_d_map_X2Y_vect end interface interface psb_map_Y2X @@ -65,6 +75,16 @@ module psb_d_linmap_mod integer, intent(out) :: info real(psb_dpk_), optional :: work(:) end subroutine psb_d_map_Y2X + subroutine psb_d_map_Y2X_vect(alpha,x,beta,y,map,info,work) + use psb_d_vect_mod + use psb_linmap_type_mod + implicit none + type(psb_dlinmap_type), intent(in) :: map + real(psb_dpk_), intent(in) :: alpha,beta + type(psb_d_vect_type), intent(inout) :: x,y + integer, intent(out) :: info + real(psb_dpk_), optional :: work(:) + end subroutine psb_d_map_Y2X_vect end interface @@ -144,7 +164,8 @@ contains class(psb_d_base_sparse_mat), intent(in), optional :: mold call map%map_X2Y%cscnv(info,type=type,mold=mold) - if (info == psb_success_) call map%map_Y2X%cscnv(info,type=type,mold=mold) + if (info == psb_success_)& + & call map%map_Y2X%cscnv(info,type=type,mold=mold) end subroutine psb_d_map_cscnv diff --git a/base/modules/psb_d_mat_mod.f90 b/base/modules/psb_d_mat_mod.f90 index 226dcd31c..452a0dec3 100644 --- a/base/modules/psb_d_mat_mod.f90 +++ b/base/modules/psb_d_mat_mod.f90 @@ -132,21 +132,24 @@ module psb_d_mat_mod ! Computational routines procedure, pass(a) :: get_diag => psb_d_get_diag + procedure, pass(a) :: maxval => psb_d_maxval procedure, pass(a) :: csnmi => psb_d_csnmi procedure, pass(a) :: csnm1 => psb_d_csnm1 procedure, pass(a) :: rowsum => psb_d_rowsum procedure, pass(a) :: arwsum => psb_d_arwsum procedure, pass(a) :: colsum => psb_d_colsum procedure, pass(a) :: aclsum => psb_d_aclsum + procedure, pass(a) :: d_csmv_v => psb_d_csmv_vect procedure, pass(a) :: d_csmv => psb_d_csmv procedure, pass(a) :: d_csmm => psb_d_csmm - generic, public :: csmm => d_csmm, d_csmv + generic, public :: csmm => d_csmm, d_csmv, d_csmv_v procedure, pass(a) :: d_scals => psb_d_scals procedure, pass(a) :: d_scal => psb_d_scal generic, public :: scal => d_scals, d_scal + procedure, pass(a) :: d_cssv_v => psb_d_cssv_vect procedure, pass(a) :: d_cssv => psb_d_cssv procedure, pass(a) :: d_cssm => psb_d_cssm - generic, public :: cssm => d_cssm, d_cssv + generic, public :: cssm => d_cssm, d_cssv, d_cssv_v end type psb_dspmat_type @@ -606,6 +609,16 @@ module psb_d_mat_mod integer, intent(out) :: info character, optional, intent(in) :: trans end subroutine psb_d_csmv + subroutine psb_d_csmv_vect(alpha,a,x,beta,y,info,trans) + use psb_d_vect_mod, only : psb_d_vect_type + import :: psb_dspmat_type, psb_dpk_ + class(psb_dspmat_type), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta + type(psb_d_vect_type), intent(inout) :: x + type(psb_d_vect_type), intent(inout) :: y + integer, intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_csmv_vect end interface interface psb_cssm @@ -627,8 +640,27 @@ module psb_d_mat_mod character, optional, intent(in) :: trans, scale real(psb_dpk_), intent(in), optional :: d(:) end subroutine psb_d_cssv + subroutine psb_d_cssv_vect(alpha,a,x,beta,y,info,trans,scale,d) + use psb_d_vect_mod, only : psb_d_vect_type + import :: psb_dspmat_type, psb_dpk_ + class(psb_dspmat_type), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta + type(psb_d_vect_type), intent(inout) :: x + type(psb_d_vect_type), intent(inout) :: y + integer, intent(out) :: info + character, optional, intent(in) :: trans, scale + type(psb_d_vect_type), optional, intent(inout) :: d + end subroutine psb_d_cssv_vect end interface + interface + function psb_d_maxval(a) result(res) + import :: psb_dspmat_type, psb_dpk_ + class(psb_dspmat_type), intent(in) :: a + real(psb_dpk_) :: res + end function psb_d_maxval + end interface + interface function psb_d_csnmi(a) result(res) import :: psb_dspmat_type, psb_dpk_ @@ -751,7 +783,6 @@ contains end function psb_d_get_fmt - function psb_d_get_dupl(a) result(res) implicit none class(psb_dspmat_type), intent(in) :: a diff --git a/base/modules/psb_d_psblas_mod.f90 b/base/modules/psb_d_psblas_mod.f90 index 1f397466f..45290f164 100644 --- a/base/modules/psb_d_psblas_mod.f90 +++ b/base/modules/psb_d_psblas_mod.f90 @@ -32,24 +32,31 @@ module psb_d_psblas_mod interface psb_gedot - function psb_ddotv(x, y, desc_a,info) + function psb_ddot_vect(x, y, desc_a,info) result(res) use psb_descriptor_type, only : psb_desc_type, psb_dpk_ - real(psb_dpk_) :: psb_ddotv + use psb_d_vect_mod, only : psb_d_vect_type + real(psb_dpk_) :: res + type(psb_d_vect_type), intent(inout) :: x, y + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + end function psb_ddot_vect + function psb_ddotv(x, y, desc_a,info) result(res) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + real(psb_dpk_) :: res real(psb_dpk_), intent(in) :: x(:), y(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info end function psb_ddotv - function psb_ddot(x, y, desc_a, info, jx, jy) + function psb_ddot(x, y, desc_a, info, jx, jy) result(res) use psb_descriptor_type, only : psb_desc_type, psb_dpk_ - real(psb_dpk_) :: psb_ddot + real(psb_dpk_) :: res real(psb_dpk_), intent(in) :: x(:,:), y(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer, optional, intent(in) :: jx, jy - integer, intent(out) :: info + type(psb_desc_type), intent(in) :: desc_a + integer, optional, intent(in) :: jx, jy + integer, intent(out) :: info end function psb_ddot end interface - interface psb_gedots subroutine psb_ddotvs(res,x, y, desc_a, info) use psb_descriptor_type, only : psb_desc_type, psb_dpk_ @@ -68,6 +75,16 @@ module psb_d_psblas_mod end interface interface psb_geaxpby + subroutine psb_daxpby_vect(alpha, x, beta, y,& + & desc_a, info) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + use psb_d_vect_mod, only : psb_d_vect_type + type(psb_d_vect_type), intent (inout) :: x + type(psb_d_vect_type), intent (inout) :: y + real(psb_dpk_), intent (in) :: alpha, beta + type(psb_desc_type), intent (in) :: desc_a + integer, intent(out) :: info + end subroutine psb_daxpby_vect subroutine psb_daxpbyv(alpha, x, beta, y,& & desc_a, info) use psb_descriptor_type, only : psb_desc_type, psb_dpk_ @@ -105,6 +122,14 @@ module psb_d_psblas_mod type(psb_desc_type), intent (in) :: desc_a integer, intent(out) :: info end function psb_damaxv + function psb_damax_vect(x, desc_a, info) result(res) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + use psb_d_vect_mod, only : psb_d_vect_type + real(psb_dpk_) :: res + type(psb_d_vect_type), intent (inout) :: x + type(psb_desc_type), intent (in) :: desc_a + integer, intent(out) :: info + end function psb_damax_vect end interface interface psb_geamaxs @@ -126,6 +151,14 @@ module psb_d_psblas_mod end interface interface psb_geasum + function psb_dasum_vect(x, desc_a, info) result(res) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + use psb_d_vect_mod, only : psb_d_vect_type + real(psb_dpk_) :: res + type(psb_d_vect_type), intent (inout) :: x + type(psb_desc_type), intent (in) :: desc_a + integer, intent(out) :: info + end function psb_dasum_vect function psb_dasum(x, desc_a, info, jx) use psb_descriptor_type, only : psb_desc_type, psb_dpk_ real(psb_dpk_) psb_dasum @@ -177,6 +210,14 @@ module psb_d_psblas_mod type(psb_desc_type), intent (in) :: desc_a integer, intent(out) :: info end function psb_dnrm2v + function psb_dnrm2_vect(x, desc_a, info) result(res) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + use psb_d_vect_mod, only : psb_d_vect_type + real(psb_dpk_) :: res + type(psb_d_vect_type), intent (inout) :: x + type(psb_desc_type), intent (in) :: desc_a + integer, intent(out) :: info + end function psb_dnrm2_vect end interface interface psb_genrm2s @@ -242,6 +283,21 @@ module psb_d_psblas_mod logical, optional, intent(in) :: doswap integer, intent(out) :: info end subroutine psb_dspmv + subroutine psb_dspmv_vect(alpha, a, x, beta, y,& + & desc_a, info, trans, work,doswap) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + use psb_d_vect_mod, only : psb_d_vect_type + use psb_mat_mod, only : psb_dspmat_type + type(psb_dspmat_type), intent(in) :: a + type(psb_d_vect_type), intent(inout) :: x + type(psb_d_vect_type), intent(inout) :: y + real(psb_dpk_), intent(in) :: alpha, beta + type(psb_desc_type), intent(in) :: desc_a + character, optional, intent(in) :: trans + real(psb_dpk_), optional, intent(inout),target :: work(:) + logical, optional, intent(in) :: doswap + integer, intent(out) :: info + end subroutine psb_dspmv_vect end interface interface psb_spsm @@ -278,6 +334,23 @@ module psb_d_psblas_mod real(psb_dpk_), optional, intent(inout), target :: work(:) integer, intent(out) :: info end subroutine psb_dspsv + subroutine psb_dspsv_vect(alpha, t, x, beta, y,& + & desc_a, info, trans, scale, choice,& + & diag, work) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + use psb_d_vect_mod, only : psb_d_vect_type + use psb_mat_mod, only : psb_dspmat_type + type(psb_dspmat_type), intent(inout) :: t + type(psb_d_vect_type), intent(inout) :: x + type(psb_d_vect_type), intent(inout) :: y + real(psb_dpk_), intent(in) :: alpha, beta + type(psb_desc_type), intent(in) :: desc_a + character, optional, intent(in) :: trans, scale + integer, optional, intent(in) :: choice + type(psb_d_vect_type), intent(inout), optional :: diag + real(psb_dpk_), optional, intent(inout), target :: work(:) + integer, intent(out) :: info + end subroutine psb_dspsv_vect end interface end module psb_d_psblas_mod diff --git a/base/modules/psb_d_tools_mod.f90 b/base/modules/psb_d_tools_mod.f90 index 49ce195c0..ef4a2d2d9 100644 --- a/base/modules/psb_d_tools_mod.f90 +++ b/base/modules/psb_d_tools_mod.f90 @@ -48,9 +48,24 @@ Module psb_d_tools_mod integer,intent(out) :: info integer, optional, intent(in) :: n end subroutine psb_dallocv + subroutine psb_dalloc_vect(x, desc_a,info,n) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + use psb_d_vect_mod + type(psb_d_vect_type), intent(out) :: x + type(psb_desc_type), intent(in) :: desc_a + integer,intent(out) :: info + integer, optional, intent(in) :: n + end subroutine psb_dalloc_vect + subroutine psb_dalloc_vect_r2(x, desc_a,info,n,lb) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + use psb_d_vect_mod + type(psb_d_vect_type), allocatable, intent(out) :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer,intent(out) :: info + integer, optional, intent(in) :: n, lb + end subroutine psb_dalloc_vect_r2 end interface - interface psb_geasb subroutine psb_dasb(x, desc_a, info) use psb_descriptor_type, only : psb_desc_type, psb_dpk_ @@ -64,6 +79,22 @@ Module psb_d_tools_mod real(psb_dpk_), allocatable, intent(inout) :: x(:) integer, intent(out) :: info end subroutine psb_dasbv + subroutine psb_dasb_vect(x, desc_a, info,mold) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + use psb_d_vect_mod + type(psb_desc_type), intent(in) :: desc_a + type(psb_d_vect_type), intent(inout) :: x + integer, intent(out) :: info + class(psb_d_base_vect_type), intent(in), optional :: mold + end subroutine psb_dasb_vect + subroutine psb_dasb_vect_r2(x, desc_a, info,mold) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + use psb_d_vect_mod + type(psb_desc_type), intent(in) :: desc_a + type(psb_d_vect_type), intent(inout) :: x(:) + integer, intent(out) :: info + class(psb_d_base_vect_type), intent(in), optional :: mold + end subroutine psb_dasb_vect_r2 end interface interface psb_sphalo @@ -94,18 +125,32 @@ Module psb_d_tools_mod type(psb_desc_type), intent(in) :: desc_a integer, intent(out) :: info end subroutine psb_dfreev + subroutine psb_dfree_vect(x, desc_a, info) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + use psb_d_vect_mod + type(psb_desc_type), intent(in) :: desc_a + type(psb_d_vect_type), intent(inout) :: x + integer, intent(out) :: info + end subroutine psb_dfree_vect + subroutine psb_dfree_vect_r2(x, desc_a, info) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + use psb_d_vect_mod + type(psb_desc_type), intent(in) :: desc_a + type(psb_d_vect_type), allocatable, intent(inout) :: x(:) + integer, intent(out) :: info + end subroutine psb_dfree_vect_r2 end interface interface psb_geins subroutine psb_dinsi(m,irw,val, x,desc_a,info,dupl) use psb_descriptor_type, only : psb_desc_type, psb_dpk_ - integer, intent(in) :: m - type(psb_desc_type), intent(in) :: desc_a - real(psb_dpk_),intent(inout) :: x(:,:) - integer, intent(in) :: irw(:) + integer, intent(in) :: m + type(psb_desc_type), intent(in) :: desc_a + real(psb_dpk_),intent(inout) :: x(:,:) + integer, intent(in) :: irw(:) real(psb_dpk_), intent(in) :: val(:,:) - integer, intent(out) :: info - integer, optional, intent(in) :: dupl + integer, intent(out) :: info + integer, optional, intent(in) :: dupl end subroutine psb_dinsi subroutine psb_dinsvi(m,irw,val,x,desc_a,info,dupl) use psb_descriptor_type, only : psb_desc_type, psb_dpk_ @@ -117,6 +162,28 @@ Module psb_d_tools_mod integer, intent(out) :: info integer, optional, intent(in) :: dupl end subroutine psb_dinsvi + subroutine psb_dins_vect(m,irw,val,x,desc_a,info,dupl) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + use psb_d_vect_mod + integer, intent(in) :: m + type(psb_desc_type), intent(in) :: desc_a + type(psb_d_vect_type), intent(inout) :: x + integer, intent(in) :: irw(:) + real(psb_dpk_), intent(in) :: val(:) + integer, intent(out) :: info + integer, optional, intent(in) :: dupl + end subroutine psb_dins_vect + subroutine psb_dins_vect_r2(m,irw,val,x,desc_a,info,dupl) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + use psb_d_vect_mod + integer, intent(in) :: m + type(psb_desc_type), intent(in) :: desc_a + type(psb_d_vect_type), intent(inout) :: x(:) + integer, intent(in) :: irw(:) + real(psb_dpk_), intent(in) :: val(:,:) + integer, intent(out) :: info + integer, optional, intent(in) :: dupl + end subroutine psb_dins_vect_r2 end interface @@ -203,88 +270,4 @@ Module psb_d_tools_mod end subroutine psb_dsprn end interface -!!$ -!!$ interface psb_linmap_init -!!$ module procedure psb_dlinmap_init -!!$ end interface -!!$ -!!$ interface psb_linmap_ins -!!$ module procedure psb_dlinmap_ins -!!$ end interface -!!$ -!!$ interface psb_linmap_asb -!!$ module procedure psb_dlinmap_asb -!!$ end interface -!!$ -!!$contains -!!$ -!!$ subroutine psb_dlinmap_init(a_map,cd_xt,descin,descout) -!!$ use psb_descriptor_type -!!$ use psb_serial_mod -!!$ use psb_penv_mod -!!$ use psb_error_mod -!!$ use psb_base_tools_mod -!!$ use psb_d_mat_mod -!!$ implicit none -!!$ type(psb_dspmat_type), intent(out) :: a_map -!!$ type(psb_desc_type), intent(out) :: cd_xt -!!$ type(psb_desc_type), intent(in) :: descin, descout -!!$ -!!$ integer :: nrow_in, nrow_out, ncol_in, info, ictxt -!!$ -!!$ ictxt = psb_cd_get_context(descin) -!!$ call psb_cdcpy(descin,cd_xt,info) -!!$ if (info == psb_success_) call psb_cd_reinit(cd_xt,info) -!!$ if (info /= psb_success_) then -!!$ write(psb_err_unit,*) 'Error on reinitialising the extension map' -!!$ call psb_error(ictxt) -!!$ call psb_abort(ictxt) -!!$ stop -!!$ end if -!!$ -!!$ nrow_in = psb_cd_get_local_rows(cd_xt) -!!$ ncol_in = psb_cd_get_local_cols(cd_xt) -!!$ nrow_out = psb_cd_get_local_rows(descout) -!!$ -!!$ call a_map%csall(nrow_out,ncol_in,info) -!!$ -!!$ end subroutine psb_dlinmap_init -!!$ -!!$ subroutine psb_dlinmap_ins(nz,ir,ic,val,a_map,cd_xt,descin,descout) -!!$ use psb_d_mat_mod -!!$ use psb_descriptor_type -!!$ implicit none -!!$ integer, intent(in) :: nz -!!$ integer, intent(in) :: ir(:),ic(:) -!!$ real(psb_dpk_), intent(in) :: val(:) -!!$ type(psb_dspmat_type), intent(inout) :: a_map -!!$ type(psb_desc_type), intent(inout) :: cd_xt -!!$ type(psb_desc_type), intent(in) :: descin, descout -!!$ integer :: info -!!$ call psb_spins(nz,ir,ic,val,a_map,descout,cd_xt,info) -!!$ -!!$ end subroutine psb_dlinmap_ins -!!$ -!!$ subroutine psb_dlinmap_asb(a_map,cd_xt,descin,descout,afmt) -!!$ use psb_base_tools_mod -!!$ use psb_d_mat_mod -!!$ use psb_descriptor_type -!!$ use psb_serial_mod -!!$ implicit none -!!$ type(psb_dspmat_type), intent(inout) :: a_map -!!$ type(psb_desc_type), intent(inout) :: cd_xt -!!$ type(psb_desc_type), intent(in) :: descin, descout -!!$ character(len=*), optional, intent(in) :: afmt -!!$ -!!$ -!!$ integer :: nrow_in, nrow_out, ncol_in, info, ictxt -!!$ -!!$ ictxt = psb_cd_get_context(descin) -!!$ -!!$ call psb_cdasb(cd_xt,info) -!!$ call a_map%set_ncols(psb_cd_get_local_cols(cd_xt)) -!!$ call a_map%cscnv(info,type=afmt) -!!$ -!!$ end subroutine psb_dlinmap_asb -!!$ end module psb_d_tools_mod diff --git a/base/modules/psb_d_vect_mod.f90 b/base/modules/psb_d_vect_mod.f90 new file mode 100644 index 000000000..dcff46de4 --- /dev/null +++ b/base/modules/psb_d_vect_mod.f90 @@ -0,0 +1,505 @@ +module psb_d_vect_mod + + use psb_d_base_vect_mod + + type psb_d_vect_type + class(psb_d_base_vect_type), allocatable :: v + contains + procedure, pass(x) :: get_nrows => d_vect_get_nrows + procedure, pass(x) :: dot_v => d_vect_dot_v + procedure, pass(x) :: dot_a => d_vect_dot_a + generic, public :: dot => dot_v, dot_a + procedure, pass(y) :: axpby_v => d_vect_axpby_v + procedure, pass(y) :: axpby_a => d_vect_axpby_a + generic, public :: axpby => axpby_v, axpby_a + procedure, pass(y) :: mlt_v => d_vect_mlt_v + procedure, pass(y) :: mlt_a => d_vect_mlt_a + procedure, pass(z) :: mlt_a_2 => d_vect_mlt_a_2 + procedure, pass(z) :: mlt_v_2 => d_vect_mlt_v_2 + procedure, pass(z) :: mlt_va => d_vect_mlt_va + procedure, pass(z) :: mlt_av => d_vect_mlt_av + generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,& + & mlt_v_2, mlt_av, mlt_va + procedure, pass(x) :: scal => d_vect_scal + procedure, pass(x) :: nrm2 => d_vect_nrm2 + procedure, pass(x) :: amax => d_vect_amax + procedure, pass(x) :: asum => d_vect_asum + procedure, pass(x) :: all => d_vect_all + procedure, pass(x) :: zero => d_vect_zero + procedure, pass(x) :: asb => d_vect_asb + procedure, pass(x) :: sync => d_vect_sync + procedure, pass(x) :: gthab => d_vect_gthab + procedure, pass(x) :: gthzv => d_vect_gthzv + generic, public :: gth => gthab, gthzv + procedure, pass(y) :: sctb => d_vect_sctb + generic, public :: sct => sctb + procedure, pass(x) :: free => d_vect_free + procedure, pass(x) :: ins => d_vect_ins + procedure, pass(x) :: bld_x => d_vect_bld_x + procedure, pass(x) :: bld_n => d_vect_bld_n + generic, public :: bld => bld_x, bld_n + procedure, pass(x) :: getCopy => d_vect_getCopy + procedure, pass(x) :: cpy_vect => d_vect_cpy_vect + generic, public :: assignment(=) => cpy_vect + procedure, pass(x) :: cnv => d_vect_cnv + procedure, pass(x) :: set_scal => d_vect_set_scal + procedure, pass(x) :: set_vect => d_vect_set_vect + generic, public :: set => set_vect, set_scal + end type psb_d_vect_type + + public :: psb_d_vect + private :: constructor, size_const + interface psb_d_vect + module procedure constructor, size_const + end interface psb_d_vect + +contains + + subroutine d_vect_bld_x(x,invect,mold) + real(psb_dpk_), intent(in) :: invect(:) + class(psb_d_vect_type), intent(out) :: x + class(psb_d_base_vect_type), intent(in), optional :: mold + integer :: info + + if (present(mold)) then + allocate(x%v,stat=info,mold=mold) + else + allocate(psb_d_base_vect_type :: x%v,stat=info) + endif + + if (info == psb_success_) call x%v%bld(invect) + + end subroutine d_vect_bld_x + + + subroutine d_vect_bld_n(x,n,mold) + integer, intent(in) :: n + class(psb_d_vect_type), intent(out) :: x + class(psb_d_base_vect_type), intent(in), optional :: mold + integer :: info + + if (present(mold)) then + allocate(x%v,stat=info,mold=mold) + else + allocate(psb_d_base_vect_type :: x%v,stat=info) + endif + if (info == psb_success_) call x%v%bld(n) + + end subroutine d_vect_bld_n + + function d_vect_getCopy(x) result(res) + class(psb_d_vect_type), intent(in) :: x + real(psb_dpk_), allocatable :: res(:) + integer :: info + + if (allocated(x%v)) res = x%v%getCopy() + + end function d_vect_getCopy + + subroutine d_vect_cpy_vect(res,x) + real(psb_dpk_), allocatable, intent(out) :: res(:) + class(psb_d_vect_type), intent(in) :: x + integer :: info + + if (allocated(x%v)) res = x%v + + end subroutine d_vect_cpy_vect + + subroutine d_vect_set_scal(x,val) + class(psb_d_vect_type), intent(inout) :: x + real(psb_dpk_), intent(in) :: val + + integer :: info + if (allocated(x%v)) call x%v%set(val) + + end subroutine d_vect_set_scal + + subroutine d_vect_set_vect(x,val) + class(psb_d_vect_type), intent(inout) :: x + real(psb_dpk_), intent(in) :: val(:) + + integer :: info + if (allocated(x%v)) call x%v%set(val) + + end subroutine d_vect_set_vect + + + function constructor(x) result(this) + real(psb_dpk_) :: x(:) + type(psb_d_vect_type) :: this + integer :: info + + allocate(psb_d_base_vect_type :: this%v, stat=info) + + if (info == 0) call this%v%bld(x) + + call this%asb(size(x),info) + + end function constructor + + + function size_const(n) result(this) + integer, intent(in) :: n + type(psb_d_vect_type) :: this + integer :: info + + allocate(psb_d_base_vect_type :: this%v, stat=info) + call this%asb(n,info) + + end function size_const + + + function d_vect_get_nrows(x) result(res) + implicit none + class(psb_d_vect_type), intent(in) :: x + integer :: res + res = -1 + if (allocated(x%v)) res = x%v%get_nrows() + end function d_vect_get_nrows + + function d_vect_dot_v(n,x,y) result(res) + implicit none + class(psb_d_vect_type), intent(inout) :: x, y + integer, intent(in) :: n + real(psb_dpk_) :: res + real(psb_dpk_), external :: ddot + + res = dzero + if (allocated(x%v).and.allocated(y%v)) & + & res = x%v%dot(n,y%v) + + end function d_vect_dot_v + + function d_vect_dot_a(n,x,y) result(res) + implicit none + class(psb_d_vect_type), intent(inout) :: x + real(psb_dpk_), intent(in) :: y(:) + integer, intent(in) :: n + real(psb_dpk_) :: res + real(psb_dpk_), external :: ddot + + res = dzero + if (allocated(x%v)) & + & res = x%v%dot(n,y) + + end function d_vect_dot_a + + subroutine d_vect_axpby_v(m,alpha, x, beta, y, info) + use psi_serial_mod + implicit none + integer, intent(in) :: m + class(psb_d_vect_type), intent(inout) :: x + class(psb_d_vect_type), intent(inout) :: y + real(psb_dpk_), intent (in) :: alpha, beta + integer, intent(out) :: info + + if (allocated(x%v).and.allocated(y%v)) then + call y%v%axpby(m,alpha,x%v,beta,info) + else + info = psb_err_invalid_vect_state_ + end if + + end subroutine d_vect_axpby_v + + subroutine d_vect_axpby_a(m,alpha, x, beta, y, info) + use psi_serial_mod + implicit none + integer, intent(in) :: m + real(psb_dpk_), intent(in) :: x(:) + class(psb_d_vect_type), intent(inout) :: y + real(psb_dpk_), intent (in) :: alpha, beta + integer, intent(out) :: info + + if (allocated(y%v)) & + & call y%v%axpby(m,alpha,x,beta,info) + + end subroutine d_vect_axpby_a + + + subroutine d_vect_mlt_v(x, y, info) + use psi_serial_mod + implicit none + class(psb_d_vect_type), intent(inout) :: x + class(psb_d_vect_type), intent(inout) :: y + integer, intent(out) :: info + integer :: i, n + + info = 0 + if (allocated(x%v).and.allocated(y%v)) & + & call y%v%mlt(x%v,info) + + end subroutine d_vect_mlt_v + + subroutine d_vect_mlt_a(x, y, info) + use psi_serial_mod + implicit none + real(psb_dpk_), intent(in) :: x(:) + class(psb_d_vect_type), intent(inout) :: y + integer, intent(out) :: info + integer :: i, n + + + info = 0 + if (allocated(y%v)) & + & call y%v%mlt(x,info) + + end subroutine d_vect_mlt_a + + + subroutine d_vect_mlt_a_2(alpha,x,y,beta,z,info) + use psi_serial_mod + implicit none + real(psb_dpk_), intent(in) :: alpha,beta + real(psb_dpk_), intent(in) :: y(:) + real(psb_dpk_), intent(in) :: x(:) + class(psb_d_vect_type), intent(inout) :: z + integer, intent(out) :: info + integer :: i, n + + info = 0 + if (allocated(z%v)) & + & call z%v%mlt(alpha,x,y,beta,info) + + end subroutine d_vect_mlt_a_2 + + subroutine d_vect_mlt_v_2(alpha,x,y,beta,z,info) + use psi_serial_mod + implicit none + real(psb_dpk_), intent(in) :: alpha,beta + class(psb_d_vect_type), intent(inout) :: x + class(psb_d_vect_type), intent(inout) :: y + class(psb_d_vect_type), intent(inout) :: z + integer, intent(out) :: info + integer :: i, n + + info = 0 + if (allocated(x%v).and.allocated(y%v).and.& + & allocated(z%v)) & + & call z%v%mlt(alpha,x%v,y%v,beta,info) + + end subroutine d_vect_mlt_v_2 + + subroutine d_vect_mlt_av(alpha,x,y,beta,z,info) + use psi_serial_mod + implicit none + real(psb_dpk_), intent(in) :: alpha,beta + real(psb_dpk_), intent(in) :: x(:) + class(psb_d_vect_type), intent(inout) :: y + class(psb_d_vect_type), intent(inout) :: z + integer, intent(out) :: info + integer :: i, n + + info = 0 + if (allocated(z%v).and.allocated(y%v)) & + & call z%v%mlt(alpha,x,y%v,beta,info) + + end subroutine d_vect_mlt_av + + subroutine d_vect_mlt_va(alpha,x,y,beta,z,info) + use psi_serial_mod + implicit none + real(psb_dpk_), intent(in) :: alpha,beta + real(psb_dpk_), intent(in) :: y(:) + class(psb_d_vect_type), intent(inout) :: x + class(psb_d_vect_type), intent(inout) :: z + integer, intent(out) :: info + integer :: i, n + + info = 0 + + if (allocated(z%v).and.allocated(x%v)) & + & call z%v%mlt(alpha,x%v,y,beta,info) + + end subroutine d_vect_mlt_va + + subroutine d_vect_scal(alpha, x) + use psi_serial_mod + implicit none + class(psb_d_vect_type), intent(inout) :: x + real(psb_dpk_), intent (in) :: alpha + + if (allocated(x%v)) call x%v%scal(alpha) + + end subroutine d_vect_scal + + + function d_vect_nrm2(n,x) result(res) + implicit none + class(psb_d_vect_type), intent(inout) :: x + integer, intent(in) :: n + real(psb_dpk_) :: res + + if (allocated(x%v)) then + res = x%v%nrm2(n) + else + res = dzero + end if + + end function d_vect_nrm2 + + function d_vect_amax(n,x) result(res) + implicit none + class(psb_d_vect_type), intent(inout) :: x + integer, intent(in) :: n + real(psb_dpk_) :: res + + if (allocated(x%v)) then + res = x%v%amax(n) + else + res = dzero + end if + + end function d_vect_amax + + function d_vect_asum(n,x) result(res) + implicit none + class(psb_d_vect_type), intent(inout) :: x + integer, intent(in) :: n + real(psb_dpk_) :: res + + if (allocated(x%v)) then + res = x%v%asum(n) + else + res = dzero + end if + + end function d_vect_asum + + subroutine d_vect_all(n, x, info, mold) + + implicit none + integer, intent(in) :: n + class(psb_d_vect_type), intent(out) :: x + class(psb_d_base_vect_type), intent(in), optional :: mold + integer, intent(out) :: info + + if (present(mold)) then + allocate(x%v,stat=info,mold=mold) + else + allocate(psb_d_base_vect_type :: x%v,stat=info) + endif + if (info == 0) then + call x%v%all(n,info) + else + info = psb_err_alloc_dealloc_ + end if + + end subroutine d_vect_all + + subroutine d_vect_zero(x) + use psi_serial_mod + implicit none + class(psb_d_vect_type), intent(inout) :: x + + if (allocated(x%v)) call x%v%zero() + + end subroutine d_vect_zero + + subroutine d_vect_asb(n, x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + integer, intent(in) :: n + class(psb_d_vect_type), intent(inout) :: x + integer, intent(out) :: info + + if (allocated(x%v)) & + & call x%v%asb(n,info) + + end subroutine d_vect_asb + + subroutine d_vect_sync(x) + implicit none + class(psb_d_vect_type), intent(inout) :: x + + if (allocated(x%v)) & + & call x%v%sync() + + end subroutine d_vect_sync + + subroutine d_vect_gthab(n,idx,alpha,x,beta,y) + use psi_serial_mod + integer :: n, idx(:) + real(psb_dpk_) :: alpha, beta, y(:) + class(psb_d_vect_type) :: x + + if (allocated(x%v)) & + & call x%v%gth(n,idx,alpha,beta,y) + + end subroutine d_vect_gthab + + subroutine d_vect_gthzv(n,idx,x,y) + use psi_serial_mod + integer :: n, idx(:) + real(psb_dpk_) :: y(:) + class(psb_d_vect_type) :: x + + if (allocated(x%v)) & + & call x%v%gth(n,idx,y) + + end subroutine d_vect_gthzv + + subroutine d_vect_sctb(n,idx,x,beta,y) + use psi_serial_mod + integer :: n, idx(:) + real(psb_dpk_) :: beta, x(:) + class(psb_d_vect_type) :: y + + if (allocated(y%v)) & + & call y%v%sct(n,idx,x,beta) + + end subroutine d_vect_sctb + + subroutine d_vect_free(x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + class(psb_d_vect_type), intent(inout) :: x + integer, intent(out) :: info + + info = 0 + if (allocated(x%v)) then + call x%v%free(info) + if (info == 0) deallocate(x%v,stat=info) + end if + + end subroutine d_vect_free + + subroutine d_vect_ins(n,irl,val,dupl,x,info) + use psi_serial_mod + implicit none + class(psb_d_vect_type), intent(inout) :: x + integer, intent(in) :: n, dupl + integer, intent(in) :: irl(:) + real(psb_dpk_), intent(in) :: val(:) + integer, intent(out) :: info + + integer :: i + + info = 0 + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + return + end if + + call x%v%ins(n,irl,val,dupl,info) + + end subroutine d_vect_ins + + + subroutine d_vect_cnv(x,mold) + class(psb_d_vect_type), intent(inout) :: x + class(psb_d_base_vect_type), intent(in) :: mold + class(psb_d_base_vect_type), allocatable :: tmp + real(psb_dpk_), allocatable :: invect(:) + integer :: info + + allocate(tmp,stat=info,mold=mold) + call x%v%sync() + if (info == psb_success_) call tmp%bld(x%v%v) + call x%v%free(info) + call move_alloc(tmp,x%v) + + end subroutine d_vect_cnv + +end module psb_d_vect_mod diff --git a/base/modules/psb_error_impl.F90 b/base/modules/psb_error_impl.F90 index 98050abe1..f5873e562 100644 --- a/base/modules/psb_error_impl.F90 +++ b/base/modules/psb_error_impl.F90 @@ -5,11 +5,11 @@ subroutine psb_errcomm(ictxt, err) integer, intent(in) :: ictxt integer, intent(inout):: err integer :: temp(2) - ! Cannot use psb_amx or otherwise we have a recursion in module usage -#if !defined(SERIAL_MPI) + call psb_amx(ictxt, err) -#endif + end subroutine psb_errcomm + ! handles the occurence of an error in a serial routine subroutine psb_serror() use psb_const_mod @@ -20,7 +20,7 @@ subroutine psb_serror() character(len=40) :: a_e_d integer :: i_e_d(5) - if(psb_get_errstatus() > 0) then + if (psb_errstatus_fatal()) then if(psb_get_errverbosity() > 1) then do while (psb_get_numerr() > izero) @@ -60,15 +60,10 @@ subroutine psb_perror(ictxt) integer :: i_e_d(5) integer :: iam, np -#if defined(SERIAL_MPI) - iam = -1 -#else call psb_info(ictxt,iam,np) -#endif - - if(psb_get_errstatus() > 0) then - if(psb_get_errverbosity() > 1) then + if (psb_errstatus_fatal()) then + if (psb_get_errverbosity() > 1) then do while (psb_get_numerr() > izero) write(psb_err_unit,'(50("="))') @@ -79,11 +74,9 @@ subroutine psb_perror(ictxt) #if defined(HAVE_FLUSH_STMT) flush(0) #endif -#if defined(SERIAL_MPI) - stop -#else + call psb_abort(ictxt,-1) -#endif + else call psb_errpop(err_c, r_name, i_e_d, a_e_d) @@ -94,22 +87,11 @@ subroutine psb_perror(ictxt) #if defined(HAVE_FLUSH_STMT) flush(0) #endif -#if defined(SERIAL_MPI) - stop -#else + call psb_abort(ictxt,-1) -#endif + end if end if - if(psb_get_errstatus() > izero) then -#if defined(SERIAL_MPI) - stop -#else - call psb_abort(ictxt,err_c) -#endif - end if - - end subroutine psb_perror diff --git a/base/modules/psb_error_mod.F90 b/base/modules/psb_error_mod.F90 index 1d5cc18f1..ed2561626 100644 --- a/base/modules/psb_error_mod.F90 +++ b/base/modules/psb_error_mod.F90 @@ -31,15 +31,21 @@ !!$ module psb_error_mod use psb_const_mod - integer, parameter, public :: psb_act_ret_=0, psb_act_abort_=1, psb_no_err_=0 + integer, parameter, public :: psb_act_ret_=0, psb_act_abort_=1 integer, parameter, public :: psb_debug_ext_=1, psb_debug_outer_=2 integer, parameter, public :: psb_debug_comp_=3, psb_debug_inner_=4 integer, parameter, public :: psb_debug_serial_=8, psb_debug_serial_comp_=9 - + + integer, parameter, public :: psb_no_err_ = 0 + integer, parameter, public :: psb_err_warning_ = 1 + integer, parameter, public :: psb_err_fatal_ = 2 + ! ! Error handling ! public psb_errpush, psb_error, psb_get_errstatus,& + & psb_errstatus_fatal, psb_errstatus_warning,& + & psb_errstatus_ok, psb_warning_push,& & psb_errpop, psb_errmsg, psb_errcomm, psb_get_numerr, & & psb_get_errverbosity, psb_set_errverbosity, & & psb_erractionsave, psb_erractionrestore, & @@ -95,10 +101,10 @@ module psb_error_mod end type psb_errstack - type(psb_errstack), save :: error_stack ! the PSBLAS-2.0 error stack - integer, save :: error_status=0 ! the error status (maybe not here) - integer, save :: verbosity_level=1 ! the verbosity level (maybe not here) - integer, save :: err_action=psb_act_abort_ + type(psb_errstack), save :: error_stack + integer, save :: error_status = psb_no_err_ + integer, save :: verbosity_level = 1 + integer, save :: err_action = psb_act_abort_ integer, save :: debug_level=0, debug_unit, serial_debug_level=0 contains @@ -129,7 +135,7 @@ contains ! restores error action previously saved with psb_erractionsave subroutine psb_erractionrestore(err_act) integer, intent(in) :: err_act - err_action=err_act + err_action = err_act end subroutine psb_erractionrestore @@ -189,7 +195,6 @@ contains ! returns number of errors function psb_get_numerr() integer :: psb_get_numerr - psb_get_numerr = error_stack%n_elems end function psb_get_numerr @@ -206,13 +211,32 @@ contains ! checks the status of the error condition function psb_get_errstatus() integer :: psb_get_errstatus - psb_get_errstatus=error_status + psb_get_errstatus = error_status end function psb_get_errstatus + subroutine psb_set_errstatus(ircode) + integer :: ircode + if ((psb_no_err_<=ircode).and.(ircode <= psb_err_fatal_))& + & error_status=ircode + end subroutine psb_set_errstatus + function psb_errstatus_fatal() result(res) + logical :: res + res = (error_status == psb_err_fatal_) + end function psb_errstatus_fatal + + function psb_errstatus_warning() result(res) + logical :: res + res = (error_status == psb_err_warning_) + end function psb_errstatus_warning + + function psb_errstatus_ok() result(res) + logical :: res + res = (error_status == psb_no_err_) + end function psb_errstatus_ok ! pushes an error on the error stack - subroutine psb_errpush(err_c, r_name, i_err, a_err) + subroutine psb_stackpush(err_c, r_name, i_err, a_err) integer, intent(in) :: err_c character(len=*), intent(in) :: r_name @@ -235,11 +259,41 @@ contains new_node%next => error_stack%top error_stack%top => new_node error_stack%n_elems = error_stack%n_elems+1 - if(error_status == 0) error_status=1 nullify(new_node) + end subroutine psb_stackpush + + ! pushes an error on the error stack + subroutine psb_errpush(err_c, r_name, i_err, a_err) + + integer, intent(in) :: err_c + character(len=*), intent(in) :: r_name + character(len=*), optional :: a_err + integer, optional :: i_err(5) + + type(psb_errstack_node), pointer :: new_node + + call psb_set_errstatus(psb_err_fatal_) + call psb_stackpush(err_c, r_name, i_err, a_err) + end subroutine psb_errpush + ! pushes a warning on the error stack + subroutine psb_warning_push(err_c, r_name, i_err, a_err) + + integer, intent(in) :: err_c + character(len=*), intent(in) :: r_name + character(len=*), optional :: a_err + integer, optional :: i_err(5) + + type(psb_errstack_node), pointer :: new_node + + + if (.not.psb_errstatus_fatal())& + & call psb_set_errstatus( psb_err_warning_) + call psb_stackpush(err_c, r_name, i_err, a_err) + end subroutine psb_warning_push + ! pops an error from the error stack subroutine psb_errpop(err_c, r_name, i_e_d, a_e_d) @@ -259,14 +313,13 @@ contains old_node => error_stack%top error_stack%top => old_node%next error_stack%n_elems = error_stack%n_elems - 1 - if(error_stack%n_elems == 0) error_status=0 + if (error_stack%n_elems == 0) error_status=0 deallocate(old_node) end subroutine psb_errpop - ! prints the error msg associated to a specific error code subroutine psb_errmsg(err_c, r_name, i_e_d, a_e_d,me) @@ -277,10 +330,12 @@ contains integer, optional :: me if(present(me)) then - write(psb_err_unit,'("Process: ",i0,". PSBLAS Error (",i0,") in subroutine: ",a20)')& + write(psb_err_unit,& + & '("Process: ",i0,". PSBLAS Error (",i0,") in subroutine: ",a20)')& & me,err_c,trim(r_name) else - write(psb_err_unit,'("PSBLAS Error (",i0,") in subroutine: ",a)')err_c,trim(r_name) + write(psb_err_unit,'("PSBLAS Error (",i0,") in subroutine: ",a)')& + & err_c,trim(r_name) end if @@ -438,7 +493,9 @@ contains write(psb_err_unit,'("Invalid state for communication descriptor")') case (psb_err_invalid_a_and_cd_state_) write(psb_err_unit,'("Invalid combined state for A and DESC_A")') - case(1124:1999) + case (psb_err_invalid_vect_state_) + write(psb_err_unit,'("Invalid state for vector")') + case(1125:1999) write(psb_err_unit,'("computational error. code: ",i0)')err_c case(psb_err_context_error_) write(0,'("Parallel context error. Number of processes=-1")') diff --git a/base/modules/psb_i_comm_mod.f90 b/base/modules/psb_i_comm_mod.f90 new file mode 100644 index 000000000..9afdedb3d --- /dev/null +++ b/base/modules/psb_i_comm_mod.f90 @@ -0,0 +1,115 @@ +!!$ +!!$ Parallel Sparse BLAS version 3.0 +!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +module psb_i_comm_mod + + interface psb_ovrl + subroutine psb_iovrlm(x,desc_a,info,jx,ik,work,update,mode) + use psb_descriptor_type + integer, intent(inout), target :: x(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, intent(inout), optional, target :: work(:) + integer, intent(in), optional :: update,jx,ik,mode + end subroutine psb_iovrlm + subroutine psb_iovrlv(x,desc_a,info,work,update,mode) + use psb_descriptor_type + integer, intent(inout), target :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, intent(inout), optional, target :: work(:) + integer, intent(in), optional :: update,mode + end subroutine psb_iovrlv + end interface + + interface psb_halo + subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data) + use psb_descriptor_type + integer, intent(inout), target :: x(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + real(psb_dpk_), intent(in), optional :: alpha + integer, intent(inout), optional, target :: work(:) + integer, intent(in), optional :: mode,jx,ik,data + character, intent(in), optional :: tran + end subroutine psb_ihalom + subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode,data) + use psb_descriptor_type + integer, intent(inout) :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + real(psb_dpk_), intent(in), optional :: alpha + integer, intent(inout), optional, target :: work(:) + integer, intent(in), optional :: mode,data + character, intent(in), optional :: tran + end subroutine psb_ihalov + end interface + + + interface psb_scatter + subroutine psb_iscatterm(globx, locx, desc_a, info, root) + use psb_descriptor_type + integer, intent(out) :: locx(:,:) + integer, intent(in) :: globx(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, intent(in), optional :: root + end subroutine psb_iscatterm + subroutine psb_iscatterv(globx, locx, desc_a, info, root) + use psb_descriptor_type + integer, intent(out) :: locx(:) + integer, intent(in) :: globx(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, intent(in), optional :: root + end subroutine psb_iscatterv + end interface + + interface psb_gather + subroutine psb_igatherm(globx, locx, desc_a, info, root) + use psb_descriptor_type + integer, intent(in) :: locx(:,:) + integer, intent(out) :: globx(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, intent(in), optional :: root + end subroutine psb_igatherm + subroutine psb_igatherv(globx, locx, desc_a, info, root) + use psb_descriptor_type + integer, intent(in) :: locx(:) + integer, intent(out) :: globx(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, intent(in), optional :: root + end subroutine psb_igatherv + end interface + +end module psb_i_comm_mod diff --git a/base/modules/psb_s_base_mat_mod.f90 b/base/modules/psb_s_base_mat_mod.f90 index b125a7c23..0e67ad631 100644 --- a/base/modules/psb_s_base_mat_mod.f90 +++ b/base/modules/psb_s_base_mat_mod.f90 @@ -58,22 +58,32 @@ module psb_s_base_mat_mod use psb_base_mat_mod + use psb_s_base_vect_mod type, extends(psb_base_sparse_mat) :: psb_s_base_sparse_mat contains + procedure, pass(a) :: s_sp_mv => psb_s_base_vect_mv procedure, pass(a) :: s_csmv => psb_s_base_csmv procedure, pass(a) :: s_csmm => psb_s_base_csmm - generic, public :: csmm => s_csmm, s_csmv + generic, public :: csmm => s_csmm, s_csmv, s_sp_mv + procedure, pass(a) :: s_in_sv => psb_s_base_inner_vect_sv procedure, pass(a) :: s_inner_cssv => psb_s_base_inner_cssv procedure, pass(a) :: s_inner_cssm => psb_s_base_inner_cssm - generic, public :: inner_cssm => s_inner_cssm, s_inner_cssv + generic, public :: inner_cssm => s_inner_cssm, s_inner_cssv, s_in_sv + procedure, pass(a) :: s_vect_cssv => psb_s_base_vect_cssv procedure, pass(a) :: s_cssv => psb_s_base_cssv procedure, pass(a) :: s_cssm => psb_s_base_cssm - generic, public :: cssm => s_cssm, s_cssv + generic, public :: cssm => s_cssm, s_cssv, s_vect_cssv procedure, pass(a) :: s_scals => psb_s_base_scals procedure, pass(a) :: s_scal => psb_s_base_scal generic, public :: scal => s_scals, s_scal + procedure, pass(a) :: maxval => psb_s_base_maxval procedure, pass(a) :: csnmi => psb_s_base_csnmi + procedure, pass(a) :: csnm1 => psb_s_base_csnm1 + procedure, pass(a) :: rowsum => psb_s_base_rowsum + procedure, pass(a) :: arwsum => psb_s_base_arwsum + procedure, pass(a) :: colsum => psb_s_base_colsum + procedure, pass(a) :: aclsum => psb_s_base_aclsum procedure, pass(a) :: get_diag => psb_s_base_get_diag procedure, pass(a) :: csput => psb_s_base_csput @@ -124,7 +134,13 @@ module psb_s_base_mat_mod procedure, pass(a) :: s_inner_cssv => psb_s_coo_cssv procedure, pass(a) :: s_scals => psb_s_coo_scals procedure, pass(a) :: s_scal => psb_s_coo_scal + procedure, pass(a) :: maxval => psb_s_coo_maxval procedure, pass(a) :: csnmi => psb_s_coo_csnmi + procedure, pass(a) :: csnm1 => psb_s_coo_csnm1 + procedure, pass(a) :: rowsum => psb_s_coo_rowsum + procedure, pass(a) :: arwsum => psb_s_coo_arwsum + procedure, pass(a) :: colsum => psb_s_coo_colsum + procedure, pass(a) :: aclsum => psb_s_coo_aclsum procedure, pass(a) :: reallocate_nz => psb_s_coo_reallocate_nz procedure, pass(a) :: allocate_mnnz => psb_s_coo_allocate_mnnz procedure, pass(a) :: cp_to_coo => psb_s_cp_coo_to_coo @@ -190,6 +206,18 @@ module psb_s_base_mat_mod end subroutine psb_s_base_csmv end interface + interface + subroutine psb_s_base_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_s_base_sparse_mat, psb_spk_, psb_s_base_vect_type + class(psb_s_base_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta + class(psb_s_base_vect_type), intent(inout) :: x + class(psb_s_base_vect_type), intent(inout) :: y + integer, intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_base_vect_mv + end interface + interface subroutine psb_s_base_inner_cssm(alpha,a,x,beta,y,info,trans) import :: psb_s_base_sparse_mat, psb_spk_ @@ -212,6 +240,17 @@ module psb_s_base_mat_mod end subroutine psb_s_base_inner_cssv end interface + interface + subroutine psb_s_base_inner_vect_sv(alpha,a,x,beta,y,info,trans) + import :: psb_s_base_sparse_mat, psb_spk_, psb_s_base_vect_type + class(psb_s_base_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta + class(psb_s_base_vect_type), intent(inout) :: x, y + integer, intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_base_inner_vect_sv + end interface + interface subroutine psb_s_base_cssm(alpha,a,x,beta,y,info,trans,scale,d) import :: psb_s_base_sparse_mat, psb_spk_ @@ -236,6 +275,18 @@ module psb_s_base_mat_mod end subroutine psb_s_base_cssv end interface + interface + subroutine psb_s_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d) + import :: psb_s_base_sparse_mat, psb_spk_,psb_s_base_vect_type + class(psb_s_base_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta + class(psb_s_base_vect_type), intent(inout) :: x,y + integer, intent(out) :: info + character, optional, intent(in) :: trans, scale + class(psb_s_base_vect_type), optional, intent(inout) :: d + end subroutine psb_s_base_vect_cssv + end interface + interface subroutine psb_s_base_scals(d,a,info) import :: psb_s_base_sparse_mat, psb_spk_ @@ -254,6 +305,14 @@ module psb_s_base_mat_mod end subroutine psb_s_base_scal end interface + interface + function psb_s_base_maxval(a) result(res) + import :: psb_s_base_sparse_mat, psb_spk_ + class(psb_s_base_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + end function psb_s_base_maxval + end interface + interface function psb_s_base_csnmi(a) result(res) import :: psb_s_base_sparse_mat, psb_spk_ @@ -261,7 +320,47 @@ module psb_s_base_mat_mod real(psb_spk_) :: res end function psb_s_base_csnmi end interface + + interface + function psb_s_base_csnm1(a) result(res) + import :: psb_s_base_sparse_mat, psb_spk_ + class(psb_s_base_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + end function psb_s_base_csnm1 + end interface + + interface + subroutine psb_s_base_rowsum(d,a) + import :: psb_s_base_sparse_mat, psb_spk_ + class(psb_s_base_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_s_base_rowsum + end interface + + interface + subroutine psb_s_base_arwsum(d,a) + import :: psb_s_base_sparse_mat, psb_spk_ + class(psb_s_base_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_s_base_arwsum + end interface + interface + subroutine psb_s_base_colsum(d,a) + import :: psb_s_base_sparse_mat, psb_spk_ + class(psb_s_base_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_s_base_colsum + end interface + + interface + subroutine psb_s_base_aclsum(d,a) + import :: psb_s_base_sparse_mat, psb_spk_ + class(psb_s_base_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_s_base_aclsum + end interface + interface subroutine psb_s_base_get_diag(a,d,info) import :: psb_s_base_sparse_mat, psb_spk_ @@ -705,6 +804,14 @@ module psb_s_base_mat_mod end interface + interface + function psb_s_coo_maxval(a) result(res) + import :: psb_s_coo_sparse_mat, psb_spk_ + class(psb_s_coo_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + end function psb_s_coo_maxval + end interface + interface function psb_s_coo_csnmi(a) result(res) import :: psb_s_coo_sparse_mat, psb_spk_ @@ -713,6 +820,46 @@ module psb_s_base_mat_mod end function psb_s_coo_csnmi end interface + interface + function psb_s_coo_csnm1(a) result(res) + import :: psb_s_coo_sparse_mat, psb_spk_ + class(psb_s_coo_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + end function psb_s_coo_csnm1 + end interface + + interface + subroutine psb_s_coo_rowsum(d,a) + import :: psb_s_coo_sparse_mat, psb_spk_ + class(psb_s_coo_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_s_coo_rowsum + end interface + + interface + subroutine psb_s_coo_arwsum(d,a) + import :: psb_s_coo_sparse_mat, psb_spk_ + class(psb_s_coo_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_s_coo_arwsum + end interface + + interface + subroutine psb_s_coo_colsum(d,a) + import :: psb_s_coo_sparse_mat, psb_spk_ + class(psb_s_coo_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_s_coo_colsum + end interface + + interface + subroutine psb_s_coo_aclsum(d,a) + import :: psb_s_coo_sparse_mat, psb_spk_ + class(psb_s_coo_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_s_coo_aclsum + end interface + interface subroutine psb_s_coo_get_diag(a,d,info) import :: psb_s_coo_sparse_mat, psb_spk_ @@ -873,8 +1020,6 @@ contains ! ! == ================================== - - subroutine s_coo_free(a) implicit none diff --git a/base/modules/psb_s_base_vect_mod.f90 b/base/modules/psb_s_base_vect_mod.f90 new file mode 100644 index 000000000..3aaf149ed --- /dev/null +++ b/base/modules/psb_s_base_vect_mod.f90 @@ -0,0 +1,565 @@ +module psb_s_base_vect_mod + + use psb_const_mod + use psb_error_mod + + type psb_s_base_vect_type + real(psb_spk_), allocatable :: v(:) + contains + procedure, pass(x) :: get_nrows => s_base_get_nrows + procedure, pass(x) :: dot_v => s_base_dot_v + procedure, pass(x) :: dot_a => s_base_dot_a + generic, public :: dot => dot_v, dot_a + procedure, pass(y) :: axpby_v => s_base_axpby_v + procedure, pass(y) :: axpby_a => s_base_axpby_a + generic, public :: axpby => axpby_v, axpby_a + procedure, pass(y) :: mlt_v => s_base_mlt_v + procedure, pass(y) :: mlt_a => s_base_mlt_a + procedure, pass(z) :: mlt_a_2 => s_base_mlt_a_2 + procedure, pass(z) :: mlt_v_2 => s_base_mlt_v_2 + procedure, pass(z) :: mlt_va => s_base_mlt_va + procedure, pass(z) :: mlt_av => s_base_mlt_av + generic, public :: mlt => mlt_v, mlt_a, mlt_a_2, mlt_v_2, mlt_av, mlt_va + procedure, pass(x) :: scal => s_base_scal + procedure, pass(x) :: nrm2 => s_base_nrm2 + procedure, pass(x) :: amax => s_base_amax + procedure, pass(x) :: asum => s_base_asum + procedure, pass(x) :: all => s_base_all + procedure, pass(x) :: zero => s_base_zero + procedure, pass(x) :: asb => s_base_asb + procedure, pass(x) :: sync => s_base_sync + procedure, pass(x) :: gthab => s_base_gthab + procedure, pass(x) :: gthzv => s_base_gthzv + generic, public :: gth => gthab, gthzv + procedure, pass(y) :: sctb => s_base_sctb + generic, public :: sct => sctb + procedure, pass(x) :: free => s_base_free + procedure, pass(x) :: ins => s_base_ins + procedure, pass(x) :: bld_x => s_base_bld_x + procedure, pass(x) :: bld_n => s_base_bld_n + generic, public :: bld => bld_x, bld_n + procedure, pass(x) :: getCopy => s_base_getCopy + procedure, pass(x) :: cpy_vect => s_base_cpy_vect + generic, public :: assignment(=) => cpy_vect, set_scal + procedure, pass(x) :: set_scal => s_base_set_scal + procedure, pass(x) :: set_vect => s_base_set_vect + generic, public :: set => set_vect, set_scal + end type psb_s_base_vect_type + + public :: psb_s_base_vect + private :: constructor, size_const + interface psb_s_base_vect + module procedure constructor, size_const + end interface psb_s_base_vect + +contains + + subroutine s_base_bld_x(x,this) + use psb_realloc_mod + real(psb_spk_), intent(in) :: this(:) + class(psb_s_base_vect_type), intent(inout) :: x + integer :: info + + call psb_realloc(size(this),x%v,info) + if (info /= 0) then + call psb_errpush(psb_err_alloc_dealloc_,'base_vect_bld') + return + end if + x%v(:) = this(:) + + end subroutine s_base_bld_x + + + subroutine s_base_bld_n(x,n) + integer, intent(in) :: n + class(psb_s_base_vect_type), intent(inout) :: x + integer :: info + + call x%asb(n,info) + + end subroutine s_base_bld_n + + function s_base_getCopy(x) result(res) + class(psb_s_base_vect_type), intent(in) :: x + real(psb_spk_), allocatable :: res(:) + integer :: info + + allocate(res(x%get_nrows()),stat=info) + if (info /= 0) then + call psb_errpush(psb_err_alloc_dealloc_,'base_getCopy') + return + end if + res(:) = x%v(:) + end function s_base_getCopy + + subroutine s_base_cpy_vect(res,x) + real(psb_spk_), allocatable, intent(out) :: res(:) + class(psb_s_base_vect_type), intent(in) :: x + integer :: info + + res = x%v + + end subroutine s_base_cpy_vect + + subroutine s_base_set_scal(x,val) + class(psb_s_base_vect_type), intent(inout) :: x + real(psb_spk_), intent(in) :: val + + integer :: info + x%v = val + + end subroutine s_base_set_scal + + subroutine s_base_set_vect(x,val) + class(psb_s_base_vect_type), intent(inout) :: x + real(psb_spk_), intent(in) :: val(:) + + integer :: info + x%v = val + + end subroutine s_base_set_vect + + + function constructor(x) result(this) + real(psb_spk_) :: x(:) + type(psb_s_base_vect_type) :: this + integer :: info + + this%v = x + call this%asb(size(x),info) + end function constructor + + + function size_const(n) result(this) + integer, intent(in) :: n + type(psb_s_base_vect_type) :: this + integer :: info + + call this%asb(n,info) + + end function size_const + + + function s_base_get_nrows(x) result(res) + implicit none + class(psb_s_base_vect_type), intent(in) :: x + integer :: res + res = -1 + if (allocated(x%v)) res = size(x%v) + end function s_base_get_nrows + + function s_base_dot_v(n,x,y) result(res) + implicit none + class(psb_s_base_vect_type), intent(inout) :: x, y + integer, intent(in) :: n + real(psb_spk_) :: res + real(psb_spk_), external :: sdot + + res = szero + ! + ! Note: this is the base implementation. + ! When we get here, we are sure that X is of + ! TYPE psb_s_base_vect + ! + select type(yy => y) + type is (psb_s_base_vect_type) + res = sdot(n,x%v,1,y%v,1) + class default + res = y%dot(n,x%v) + end select + + end function s_base_dot_v + + function s_base_dot_a(n,x,y) result(res) + implicit none + class(psb_s_base_vect_type), intent(inout) :: x + real(psb_spk_), intent(in) :: y(:) + integer, intent(in) :: n + real(psb_spk_) :: res + real(psb_spk_), external :: sdot + + res = sdot(n,y,1,x%v,1) + + end function s_base_dot_a + + subroutine s_base_axpby_v(m,alpha, x, beta, y, info) + use psi_serial_mod + implicit none + integer, intent(in) :: m + class(psb_s_base_vect_type), intent(inout) :: x + class(psb_s_base_vect_type), intent(inout) :: y + real(psb_spk_), intent (in) :: alpha, beta + integer, intent(out) :: info + + select type(xx => x) + type is (psb_s_base_vect_type) + call psb_geaxpby(m,alpha,x%v,beta,y%v,info) + class default + call y%axpby(m,alpha,x%v,beta,info) + end select + + end subroutine s_base_axpby_v + + subroutine s_base_axpby_a(m,alpha, x, beta, y, info) + use psi_serial_mod + implicit none + integer, intent(in) :: m + real(psb_spk_), intent(in) :: x(:) + class(psb_s_base_vect_type), intent(inout) :: y + real(psb_spk_), intent (in) :: alpha, beta + integer, intent(out) :: info + + call psb_geaxpby(m,alpha,x,beta,y%v,info) + + end subroutine s_base_axpby_a + + + subroutine s_base_mlt_v(x, y, info) + use psi_serial_mod + implicit none + class(psb_s_base_vect_type), intent(inout) :: x + class(psb_s_base_vect_type), intent(inout) :: y + integer, intent(out) :: info + integer :: i, n + + info = 0 + select type(xx => x) + type is (psb_s_base_vect_type) + n = min(size(y%v), size(xx%v)) + do i=1, n + y%v(i) = y%v(i)*xx%v(i) + end do + class default + call y%mlt(x%v,info) + end select + + end subroutine s_base_mlt_v + + subroutine s_base_mlt_a(x, y, info) + use psi_serial_mod + implicit none + real(psb_spk_), intent(in) :: x(:) + class(psb_s_base_vect_type), intent(inout) :: y + integer, intent(out) :: info + integer :: i, n + + info = 0 + n = min(size(y%v), size(x)) + do i=1, n + y%v(i) = y%v(i)*x(i) + end do + + end subroutine s_base_mlt_a + + + subroutine s_base_mlt_a_2(alpha,x,y,beta,z,info) + use psi_serial_mod + implicit none + real(psb_spk_), intent(in) :: alpha,beta + real(psb_spk_), intent(in) :: y(:) + real(psb_spk_), intent(in) :: x(:) + class(psb_s_base_vect_type), intent(inout) :: z + integer, intent(out) :: info + integer :: i, n + + info = 0 + n = min(size(z%v), size(x), size(y)) +!!$ write(0,*) 'Mlt_a_2: ',n + if (alpha == szero) then + if (beta == sone) then + return + else + do i=1, n + z%v(i) = beta*z%v(i) + end do + end if + else + if (alpha == sone) then + if (beta == szero) then + do i=1, n + z%v(i) = y(i)*x(i) + end do + else if (beta == sone) then + do i=1, n + z%v(i) = z%v(i) + y(i)*x(i) + end do + else + do i=1, n + z%v(i) = beta*z%v(i) + y(i)*x(i) + end do + end if + else if (alpha == -sone) then + if (beta == szero) then + do i=1, n + z%v(i) = -y(i)*x(i) + end do + else if (beta == sone) then + do i=1, n + z%v(i) = z%v(i) - y(i)*x(i) + end do + else + do i=1, n + z%v(i) = beta*z%v(i) - y(i)*x(i) + end do + end if + else + if (beta == szero) then + do i=1, n + z%v(i) = alpha*y(i)*x(i) + end do + else if (beta == sone) then + do i=1, n + z%v(i) = z%v(i) + alpha*y(i)*x(i) + end do + else + do i=1, n + z%v(i) = beta*z%v(i) + alpha*y(i)*x(i) + end do + end if + end if + end if + end subroutine s_base_mlt_a_2 + + subroutine s_base_mlt_v_2(alpha,x,y,beta,z,info) + use psi_serial_mod + implicit none + real(psb_spk_), intent(in) :: alpha,beta + class(psb_s_base_vect_type), intent(inout) :: x + class(psb_s_base_vect_type), intent(inout) :: y + class(psb_s_base_vect_type), intent(inout) :: z + integer, intent(out) :: info + integer :: i, n + + info = 0 + + call z%mlt(alpha,x%v,y%v,beta,info) + + end subroutine s_base_mlt_v_2 + + subroutine s_base_mlt_av(alpha,x,y,beta,z,info) + use psi_serial_mod + implicit none + real(psb_spk_), intent(in) :: alpha,beta + real(psb_spk_), intent(in) :: x(:) + class(psb_s_base_vect_type), intent(inout) :: y + class(psb_s_base_vect_type), intent(inout) :: z + integer, intent(out) :: info + integer :: i, n + + info = 0 + + call z%mlt(alpha,x,y%v,beta,info) + + end subroutine s_base_mlt_av + + subroutine s_base_mlt_va(alpha,x,y,beta,z,info) + use psi_serial_mod + implicit none + real(psb_spk_), intent(in) :: alpha,beta + real(psb_spk_), intent(in) :: y(:) + class(psb_s_base_vect_type), intent(inout) :: x + class(psb_s_base_vect_type), intent(inout) :: z + integer, intent(out) :: info + integer :: i, n + + info = 0 + + call z%mlt(alpha,y,x,beta,info) + + end subroutine s_base_mlt_va + + subroutine s_base_scal(alpha, x) + use psi_serial_mod + implicit none + class(psb_s_base_vect_type), intent(inout) :: x + real(psb_spk_), intent (in) :: alpha + + if (allocated(x%v)) x%v = alpha*x%v + + end subroutine s_base_scal + + + function s_base_nrm2(n,x) result(res) + implicit none + class(psb_s_base_vect_type), intent(inout) :: x + integer, intent(in) :: n + real(psb_spk_) :: res + real(psb_spk_), external :: snrm2 + + res = snrm2(n,x%v,1) + + end function s_base_nrm2 + + function s_base_amax(n,x) result(res) + implicit none + class(psb_s_base_vect_type), intent(inout) :: x + integer, intent(in) :: n + real(psb_spk_) :: res + + res = maxval(abs(x%v(1:n))) + + end function s_base_amax + + function s_base_asum(n,x) result(res) + implicit none + class(psb_s_base_vect_type), intent(inout) :: x + integer, intent(in) :: n + real(psb_spk_) :: res + + res = sum(abs(x%v(1:n))) + + end function s_base_asum + + subroutine s_base_all(n, x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + integer, intent(in) :: n + class(psb_s_base_vect_type), intent(out) :: x + integer, intent(out) :: info + + call psb_realloc(n,x%v,info) + + end subroutine s_base_all + + subroutine s_base_zero(x) + use psi_serial_mod + implicit none + class(psb_s_base_vect_type), intent(inout) :: x + + if (allocated(x%v)) x%v=szero + + end subroutine s_base_zero + + subroutine s_base_asb(n, x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + integer, intent(in) :: n + class(psb_s_base_vect_type), intent(inout) :: x + integer, intent(out) :: info + + if (x%get_nrows() < n) & + & call psb_realloc(n,x%v,info) + if (info /= 0) & + & call psb_errpush(psb_err_alloc_dealloc_,'vect_asb') + + end subroutine s_base_asb + + subroutine s_base_sync(x) + implicit none + class(psb_s_base_vect_type), intent(inout) :: x + + ! + ! The base version does nothing, it's just + ! a placeholder. + ! + + end subroutine s_base_sync + + subroutine s_base_gthab(n,idx,alpha,x,beta,y) + use psi_serial_mod + integer :: n, idx(:) + real(psb_spk_) :: alpha, beta, y(:) + class(psb_s_base_vect_type) :: x + + call x%sync() + call psi_gth(n,idx,alpha,x%v,beta,y) + + end subroutine s_base_gthab + + subroutine s_base_gthzv(n,idx,x,y) + use psi_serial_mod + integer :: n, idx(:) + real(psb_spk_) :: y(:) + class(psb_s_base_vect_type) :: x + + call x%sync() + call psi_gth(n,idx,x%v,y) + + end subroutine s_base_gthzv + + subroutine s_base_sctb(n,idx,x,beta,y) + use psi_serial_mod + integer :: n, idx(:) + real(psb_spk_) :: beta, x(:) + class(psb_s_base_vect_type) :: y + + call y%sync() + call psi_sct(n,idx,x,beta,y%v) + + end subroutine s_base_sctb + + subroutine s_base_free(x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + class(psb_s_base_vect_type), intent(inout) :: x + integer, intent(out) :: info + + info = 0 + if (allocated(x%v)) deallocate(x%v, stat=info) + if (info /= 0) call & + & psb_errpush(psb_err_alloc_dealloc_,'vect_free') + + end subroutine s_base_free + + subroutine s_base_ins(n,irl,val,dupl,x,info) + use psi_serial_mod + implicit none + class(psb_s_base_vect_type), intent(inout) :: x + integer, intent(in) :: n, dupl + integer, intent(in) :: irl(:) + real(psb_spk_), intent(in) :: val(:) + integer, intent(out) :: info + + integer :: i + + info = 0 + if (psb_errstatus_fatal()) return + + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + else if (n > min(size(irl),size(val))) then + info = psb_err_invalid_input_ + + else + select case(dupl) + case(psb_dupl_ovwrt_) + do i = 1, n + !loop over all val's rows + + ! row actual block row + if (irl(i) > 0) then + ! this row belongs to me + ! copy i-th row of block val in x + x%v(irl(i)) = val(i) + end if + enddo + + case(psb_dupl_add_) + + do i = 1, n + !loop over all val's rows + + if (irl(i) > 0) then + ! this row belongs to me + ! copy i-th row of block val in x + x%v(irl(i)) = x%v(irl(i)) + val(i) + end if + enddo + + case default + info = 321 +!!$ call psb_errpush(info,name) +!!$ goto 9999 + end select + end if + if (info /= 0) then + call psb_errpush(info,'base_vect_ins') + return + end if + + end subroutine s_base_ins + +end module psb_s_base_vect_mod diff --git a/base/modules/psb_s_comm_mod.f90 b/base/modules/psb_s_comm_mod.f90 new file mode 100644 index 000000000..6864f59d7 --- /dev/null +++ b/base/modules/psb_s_comm_mod.f90 @@ -0,0 +1,155 @@ +!!$ +!!$ Parallel Sparse BLAS version 3.0 +!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +module psb_s_comm_mod + + interface psb_ovrl + subroutine psb_sovrlm(x,desc_a,info,jx,ik,work,update,mode) + use psb_descriptor_type + real(psb_spk_), intent(inout), target :: x(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + real(psb_spk_), intent(inout), optional, target :: work(:) + integer, intent(in), optional :: update,jx,ik,mode + end subroutine psb_sovrlm + subroutine psb_sovrlv(x,desc_a,info,work,update,mode) + use psb_descriptor_type + real(psb_spk_), intent(inout), target :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + real(psb_spk_), intent(inout), optional, target :: work(:) + integer, intent(in), optional :: update,mode + end subroutine psb_sovrlv + subroutine psb_sovrl_vect(x,desc_a,info,work,update,mode) + use psb_descriptor_type + use psb_s_vect_mod + type(psb_s_vect_type), intent(inout) :: x + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + real(psb_spk_), intent(inout), optional, target :: work(:) + integer, intent(in), optional :: update,mode + end subroutine psb_sovrl_vect + end interface + + interface psb_halo + subroutine psb_shalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data) + use psb_descriptor_type + real(psb_spk_), intent(inout),target :: x(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + real(psb_spk_), intent(in), optional :: alpha + real(psb_spk_), target, optional, intent(inout) :: work(:) + integer, intent(in), optional :: mode,jx,ik,data + character, intent(in), optional :: tran + end subroutine psb_shalom + subroutine psb_shalov(x,desc_a,info,alpha,work,tran,mode,data) + use psb_descriptor_type + real(psb_spk_), intent(inout) :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + real(psb_spk_), intent(in), optional :: alpha + real(psb_spk_), target, optional, intent(inout) :: work(:) + integer, intent(in), optional :: mode,data + character, intent(in), optional :: tran + end subroutine psb_shalov + subroutine psb_shalo_vect(x,desc_a,info,alpha,work,tran,mode,data) + use psb_descriptor_type + use psb_s_vect_mod + type(psb_s_vect_type), intent(inout) :: x + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + real(psb_spk_), intent(in), optional :: alpha + real(psb_spk_), target, optional, intent(inout) :: work(:) + integer, intent(in), optional :: mode,data + character, intent(in), optional :: tran + end subroutine psb_shalo_vect + end interface + + + interface psb_scatter + subroutine psb_sscatterm(globx, locx, desc_a, info, root) + use psb_descriptor_type + real(psb_spk_), intent(out) :: locx(:,:) + real(psb_spk_), intent(in) :: globx(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, intent(in), optional :: root + end subroutine psb_sscatterm + subroutine psb_sscatterv(globx, locx, desc_a, info, root) + use psb_descriptor_type + real(psb_spk_), intent(out) :: locx(:) + real(psb_spk_), intent(in) :: globx(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, intent(in), optional :: root + end subroutine psb_sscatterv + end interface + + interface psb_gather + subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) + use psb_descriptor_type + use psb_mat_mod + implicit none + type(psb_sspmat_type), intent(inout) :: loca + type(psb_sspmat_type), intent(out) :: globa + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, intent(in), optional :: root,dupl + logical, intent(in), optional :: keepnum,keeploc + end subroutine psb_ssp_allgather + subroutine psb_sgatherm(globx, locx, desc_a, info, root) + use psb_descriptor_type + real(psb_spk_), intent(in) :: locx(:,:) + real(psb_spk_), intent(out) :: globx(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, intent(in), optional :: root + end subroutine psb_sgatherm + subroutine psb_sgatherv(globx, locx, desc_a, info, root) + use psb_descriptor_type + real(psb_spk_), intent(in) :: locx(:) + real(psb_spk_), intent(out) :: globx(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, intent(in), optional :: root + end subroutine psb_sgatherv + subroutine psb_sgather_vect(globx, locx, desc_a, info, root) + use psb_descriptor_type + use psb_s_vect_mod + type(psb_s_vect_type), intent(in) :: locx + real(psb_spk_), intent(out) :: globx(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, intent(in), optional :: root + end subroutine psb_sgather_vect + end interface + +end module psb_s_comm_mod diff --git a/base/modules/psb_s_csc_mat_mod.f90 b/base/modules/psb_s_csc_mat_mod.f90 index 4f97a05a2..78b7254bb 100644 --- a/base/modules/psb_s_csc_mat_mod.f90 +++ b/base/modules/psb_s_csc_mat_mod.f90 @@ -58,7 +58,13 @@ module psb_s_csc_mat_mod procedure, pass(a) :: s_inner_cssv => psb_s_csc_cssv procedure, pass(a) :: s_scals => psb_s_csc_scals procedure, pass(a) :: s_scal => psb_s_csc_scal + procedure, pass(a) :: maxval => psb_s_csc_maxval procedure, pass(a) :: csnmi => psb_s_csc_csnmi + procedure, pass(a) :: csnm1 => psb_s_csc_csnm1 + procedure, pass(a) :: rowsum => psb_s_csc_rowsum + procedure, pass(a) :: arwsum => psb_s_csc_arwsum + procedure, pass(a) :: colsum => psb_s_csc_colsum + procedure, pass(a) :: aclsum => psb_s_csc_aclsum procedure, pass(a) :: reallocate_nz => psb_s_csc_reallocate_nz procedure, pass(a) :: allocate_mnnz => psb_s_csc_allocate_mnnz procedure, pass(a) :: cp_to_coo => psb_s_cp_csc_to_coo @@ -330,6 +336,14 @@ module psb_s_csc_mat_mod end interface + interface + function psb_s_csc_maxval(a) result(res) + import :: psb_s_csc_sparse_mat, psb_spk_ + class(psb_s_csc_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + end function psb_s_csc_maxval + end interface + interface function psb_s_csc_csnmi(a) result(res) import :: psb_s_csc_sparse_mat, psb_spk_ @@ -338,6 +352,46 @@ module psb_s_csc_mat_mod end function psb_s_csc_csnmi end interface + interface + function psb_s_csc_csnm1(a) result(res) + import :: psb_s_csc_sparse_mat, psb_spk_ + class(psb_s_csc_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + end function psb_s_csc_csnm1 + end interface + + interface + subroutine psb_s_csc_rowsum(d,a) + import :: psb_s_csc_sparse_mat, psb_spk_ + class(psb_s_csc_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_s_csc_rowsum + end interface + + interface + subroutine psb_s_csc_arwsum(d,a) + import :: psb_s_csc_sparse_mat, psb_spk_ + class(psb_s_csc_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_s_csc_arwsum + end interface + + interface + subroutine psb_s_csc_colsum(d,a) + import :: psb_s_csc_sparse_mat, psb_spk_ + class(psb_s_csc_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_s_csc_colsum + end interface + + interface + subroutine psb_s_csc_aclsum(d,a) + import :: psb_s_csc_sparse_mat, psb_spk_ + class(psb_s_csc_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_s_csc_aclsum + end interface + interface subroutine psb_s_csc_get_diag(a,d,info) import :: psb_s_csc_sparse_mat, psb_spk_ diff --git a/base/modules/psb_s_csr_mat_mod.f90 b/base/modules/psb_s_csr_mat_mod.f90 index 25c5943ed..b4dc061e5 100644 --- a/base/modules/psb_s_csr_mat_mod.f90 +++ b/base/modules/psb_s_csr_mat_mod.f90 @@ -58,7 +58,13 @@ module psb_s_csr_mat_mod procedure, pass(a) :: s_inner_cssv => psb_s_csr_cssv procedure, pass(a) :: s_scals => psb_s_csr_scals procedure, pass(a) :: s_scal => psb_s_csr_scal + procedure, pass(a) :: maxval => psb_s_csr_maxval procedure, pass(a) :: csnmi => psb_s_csr_csnmi + procedure, pass(a) :: csnm1 => psb_s_csr_csnm1 + procedure, pass(a) :: rowsum => psb_s_csr_rowsum + procedure, pass(a) :: arwsum => psb_s_csr_arwsum + procedure, pass(a) :: colsum => psb_s_csr_colsum + procedure, pass(a) :: aclsum => psb_s_csr_aclsum procedure, pass(a) :: reallocate_nz => psb_s_csr_reallocate_nz procedure, pass(a) :: allocate_mnnz => psb_s_csr_allocate_mnnz procedure, pass(a) :: cp_to_coo => psb_s_cp_csr_to_coo @@ -112,15 +118,6 @@ module psb_s_csr_mat_mod end subroutine psb_s_csr_trim end interface - interface - subroutine psb_s_csr_allocate_mnnz(m,n,a,nz) - import :: psb_s_csr_sparse_mat - integer, intent(in) :: m,n - class(psb_s_csr_sparse_mat), intent(inout) :: a - integer, intent(in), optional :: nz - end subroutine psb_s_csr_allocate_mnnz - end interface - interface subroutine psb_s_csr_mold(a,b,info) import :: psb_s_csr_sparse_mat, psb_s_base_sparse_mat, psb_long_int_k_ @@ -130,6 +127,15 @@ module psb_s_csr_mat_mod end subroutine psb_s_csr_mold end interface + interface + subroutine psb_s_csr_allocate_mnnz(m,n,a,nz) + import :: psb_s_csr_sparse_mat + integer, intent(in) :: m,n + class(psb_s_csr_sparse_mat), intent(inout) :: a + integer, intent(in), optional :: nz + end subroutine psb_s_csr_allocate_mnnz + end interface + interface subroutine psb_s_csr_print(iout,a,iv,eirs,eics,head,ivr,ivc) import :: psb_s_csr_sparse_mat @@ -330,6 +336,14 @@ module psb_s_csr_mat_mod end interface + interface + function psb_s_csr_maxval(a) result(res) + import :: psb_s_csr_sparse_mat, psb_spk_ + class(psb_s_csr_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + end function psb_s_csr_maxval + end interface + interface function psb_s_csr_csnmi(a) result(res) import :: psb_s_csr_sparse_mat, psb_spk_ @@ -338,6 +352,46 @@ module psb_s_csr_mat_mod end function psb_s_csr_csnmi end interface + interface + function psb_s_csr_csnm1(a) result(res) + import :: psb_s_csr_sparse_mat, psb_spk_ + class(psb_s_csr_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + end function psb_s_csr_csnm1 + end interface + + interface + subroutine psb_s_csr_rowsum(d,a) + import :: psb_s_csr_sparse_mat, psb_spk_ + class(psb_s_csr_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_s_csr_rowsum + end interface + + interface + subroutine psb_s_csr_arwsum(d,a) + import :: psb_s_csr_sparse_mat, psb_spk_ + class(psb_s_csr_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_s_csr_arwsum + end interface + + interface + subroutine psb_s_csr_colsum(d,a) + import :: psb_s_csr_sparse_mat, psb_spk_ + class(psb_s_csr_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_s_csr_colsum + end interface + + interface + subroutine psb_s_csr_aclsum(d,a) + import :: psb_s_csr_sparse_mat, psb_spk_ + class(psb_s_csr_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_s_csr_aclsum + end interface + interface subroutine psb_s_csr_get_diag(a,d,info) import :: psb_s_csr_sparse_mat, psb_spk_ diff --git a/base/modules/psb_s_linmap_mod.f90 b/base/modules/psb_s_linmap_mod.f90 index bbdd054dd..49bedc024 100644 --- a/base/modules/psb_s_linmap_mod.f90 +++ b/base/modules/psb_s_linmap_mod.f90 @@ -52,6 +52,16 @@ module psb_s_linmap_mod integer, intent(out) :: info real(psb_spk_), optional :: work(:) end subroutine psb_s_map_X2Y + subroutine psb_s_map_X2Y_vect(alpha,x,beta,y,map,info,work) + use psb_s_vect_mod + use psb_linmap_type_mod + implicit none + type(psb_slinmap_type), intent(in) :: map + real(psb_spk_), intent(in) :: alpha,beta + type(psb_s_vect_type), intent(inout) :: x,y + integer, intent(out) :: info + real(psb_spk_), optional :: work(:) + end subroutine psb_s_map_X2Y_vect end interface interface psb_map_Y2X @@ -65,6 +75,16 @@ module psb_s_linmap_mod integer, intent(out) :: info real(psb_spk_), optional :: work(:) end subroutine psb_s_map_Y2X + subroutine psb_s_map_Y2X_vect(alpha,x,beta,y,map,info,work) + use psb_s_vect_mod + use psb_linmap_type_mod + implicit none + type(psb_slinmap_type), intent(in) :: map + real(psb_spk_), intent(in) :: alpha,beta + type(psb_s_vect_type), intent(inout) :: x,y + integer, intent(out) :: info + real(psb_spk_), optional :: work(:) + end subroutine psb_s_map_Y2X_vect end interface diff --git a/base/modules/psb_s_mat_mod.f90 b/base/modules/psb_s_mat_mod.f90 index 497ee367a..9ae40e5e5 100644 --- a/base/modules/psb_s_mat_mod.f90 +++ b/base/modules/psb_s_mat_mod.f90 @@ -133,16 +133,24 @@ module psb_s_mat_mod ! Computational routines procedure, pass(a) :: get_diag => psb_s_get_diag + procedure, pass(a) :: maxval => psb_s_maxval procedure, pass(a) :: csnmi => psb_s_csnmi + procedure, pass(a) :: csnm1 => psb_s_csnm1 + procedure, pass(a) :: rowsum => psb_s_rowsum + procedure, pass(a) :: arwsum => psb_s_arwsum + procedure, pass(a) :: colsum => psb_s_colsum + procedure, pass(a) :: aclsum => psb_s_aclsum + procedure, pass(a) :: s_csmv_v => psb_s_csmv_vect procedure, pass(a) :: s_csmv => psb_s_csmv procedure, pass(a) :: s_csmm => psb_s_csmm - generic, public :: csmm => s_csmm, s_csmv + generic, public :: csmm => s_csmm, s_csmv, s_csmv_v procedure, pass(a) :: s_scals => psb_s_scals procedure, pass(a) :: s_scal => psb_s_scal generic, public :: scal => s_scals, s_scal + procedure, pass(a) :: s_cssv_v => psb_s_cssv_vect procedure, pass(a) :: s_cssv => psb_s_cssv procedure, pass(a) :: s_cssm => psb_s_cssm - generic, public :: cssm => s_cssm, s_cssv + generic, public :: cssm => s_cssm, s_cssv, s_cssv_v end type psb_sspmat_type @@ -602,6 +610,16 @@ module psb_s_mat_mod integer, intent(out) :: info character, optional, intent(in) :: trans end subroutine psb_s_csmv + subroutine psb_s_csmv_vect(alpha,a,x,beta,y,info,trans) + use psb_s_vect_mod, only : psb_s_vect_type + import :: psb_sspmat_type, psb_spk_ + class(psb_sspmat_type), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta + type(psb_s_vect_type), intent(inout) :: x + type(psb_s_vect_type), intent(inout) :: y + integer, intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_csmv_vect end interface interface psb_cssm @@ -623,6 +641,25 @@ module psb_s_mat_mod character, optional, intent(in) :: trans, scale real(psb_spk_), intent(in), optional :: d(:) end subroutine psb_s_cssv + subroutine psb_s_cssv_vect(alpha,a,x,beta,y,info,trans,scale,d) + use psb_s_vect_mod, only : psb_s_vect_type + import :: psb_sspmat_type, psb_spk_ + class(psb_sspmat_type), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta + type(psb_s_vect_type), intent(inout) :: x + type(psb_s_vect_type), intent(inout) :: y + integer, intent(out) :: info + character, optional, intent(in) :: trans, scale + type(psb_s_vect_type), optional, intent(inout) :: d + end subroutine psb_s_cssv_vect + end interface + + interface + function psb_s_maxval(a) result(res) + import :: psb_sspmat_type, psb_spk_ + class(psb_sspmat_type), intent(in) :: a + real(psb_spk_) :: res + end function psb_s_maxval end interface interface @@ -632,6 +669,50 @@ module psb_s_mat_mod real(psb_spk_) :: res end function psb_s_csnmi end interface + + interface + function psb_s_csnm1(a) result(res) + import :: psb_sspmat_type, psb_spk_ + class(psb_sspmat_type), intent(in) :: a + real(psb_spk_) :: res + end function psb_s_csnm1 + end interface + + interface + subroutine psb_s_rowsum(d,a,info) + import :: psb_sspmat_type, psb_spk_ + class(psb_sspmat_type), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + integer, intent(out) :: info + end subroutine psb_s_rowsum + end interface + + interface + subroutine psb_s_arwsum(d,a,info) + import :: psb_sspmat_type, psb_spk_ + class(psb_sspmat_type), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + integer, intent(out) :: info + end subroutine psb_s_arwsum + end interface + + interface + subroutine psb_s_colsum(d,a,info) + import :: psb_sspmat_type, psb_spk_ + class(psb_sspmat_type), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + integer, intent(out) :: info + end subroutine psb_s_colsum + end interface + + interface + subroutine psb_s_aclsum(d,a,info) + import :: psb_sspmat_type, psb_spk_ + class(psb_sspmat_type), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + integer, intent(out) :: info + end subroutine psb_s_aclsum + end interface interface subroutine psb_s_get_diag(a,d,info) @@ -658,8 +739,6 @@ module psb_s_mat_mod end interface - - contains @@ -913,5 +992,4 @@ contains end function psb_s_get_nz_row - end module psb_s_mat_mod diff --git a/base/modules/psb_s_psblas_mod.f90 b/base/modules/psb_s_psblas_mod.f90 index df3a7b6c8..ab196d684 100644 --- a/base/modules/psb_s_psblas_mod.f90 +++ b/base/modules/psb_s_psblas_mod.f90 @@ -32,6 +32,14 @@ module psb_s_psblas_mod interface psb_gedot + function psb_sdot_vect(x, y, desc_a,info) result(res) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + use psb_s_vect_mod, only : psb_s_vect_type + real(psb_spk_) :: res + type(psb_s_vect_type), intent(inout) :: x, y + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + end function psb_sdot_vect function psb_sdotv(x, y, desc_a,info) use psb_descriptor_type, only : psb_desc_type, psb_spk_ real(psb_spk_) :: psb_sdotv @@ -68,6 +76,16 @@ module psb_s_psblas_mod end interface interface psb_geaxpby + subroutine psb_saxpby_vect(alpha, x, beta, y,& + & desc_a, info) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + use psb_s_vect_mod, only : psb_s_vect_type + type(psb_s_vect_type), intent (inout) :: x + type(psb_s_vect_type), intent (inout) :: y + real(psb_spk_), intent (in) :: alpha, beta + type(psb_desc_type), intent (in) :: desc_a + integer, intent(out) :: info + end subroutine psb_saxpby_vect subroutine psb_saxpbyv(alpha, x, beta, y,& & desc_a, info) use psb_descriptor_type, only : psb_desc_type, psb_spk_ @@ -105,6 +123,14 @@ module psb_s_psblas_mod type(psb_desc_type), intent (in) :: desc_a integer, intent(out) :: info end function psb_samaxv + function psb_samax_vect(x, desc_a, info) result(res) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + use psb_s_vect_mod, only : psb_s_vect_type + real(psb_spk_) :: res + type(psb_s_vect_type), intent (inout) :: x + type(psb_desc_type), intent (in) :: desc_a + integer, intent(out) :: info + end function psb_samax_vect end interface interface psb_geamaxs @@ -126,6 +152,14 @@ module psb_s_psblas_mod end interface interface psb_geasum + function psb_sasum_vect(x, desc_a, info) result(res) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + use psb_s_vect_mod, only : psb_s_vect_type + real(psb_spk_) :: res + type(psb_s_vect_type), intent (inout) :: x + type(psb_desc_type), intent (in) :: desc_a + integer, intent(out) :: info + end function psb_sasum_vect function psb_sasum(x, desc_a, info, jx) use psb_descriptor_type, only : psb_desc_type, psb_spk_ real(psb_spk_) psb_sasum @@ -177,10 +211,18 @@ module psb_s_psblas_mod type(psb_desc_type), intent (in) :: desc_a integer, intent(out) :: info end function psb_snrm2v + function psb_snrm2_vect(x, desc_a, info) result(res) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + use psb_s_vect_mod, only : psb_s_vect_type + real(psb_spk_) :: res + type(psb_s_vect_type), intent (inout) :: x + type(psb_desc_type), intent (in) :: desc_a + integer, intent(out) :: info + end function psb_snrm2_vect end interface interface psb_genrm2s - subroutine psb_snrm2vs(res,x,desc_a,info) + subroutine psb_snrm2vs(res,x,desc_a,info) use psb_descriptor_type, only : psb_desc_type, psb_spk_ real(psb_spk_), intent (out) :: res real(psb_spk_), intent (in) :: x(:) @@ -201,6 +243,17 @@ module psb_s_psblas_mod end function psb_snrmi end interface + interface psb_spnrm1 + function psb_sspnrm1(a, desc_a,info) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + use psb_mat_mod, only : psb_sspmat_type + real(psb_spk_) :: psb_sspnrm1 + type(psb_sspmat_type), intent (in) :: a + type(psb_desc_type), intent (in) :: desc_a + integer, intent(out) :: info + end function psb_sspnrm1 + end interface + interface psb_spmm subroutine psb_sspmm(alpha, a, x, beta, y, desc_a, info,& &trans, k, jx, jy,work,doswap) @@ -231,6 +284,21 @@ module psb_s_psblas_mod logical, optional, intent(in) :: doswap integer, intent(out) :: info end subroutine psb_sspmv + subroutine psb_sspmv_vect(alpha, a, x, beta, y,& + & desc_a, info, trans, work,doswap) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + use psb_s_vect_mod, only : psb_s_vect_type + use psb_mat_mod, only : psb_sspmat_type + type(psb_sspmat_type), intent(in) :: a + type(psb_s_vect_type), intent(inout) :: x + type(psb_s_vect_type), intent(inout) :: y + real(psb_spk_), intent(in) :: alpha, beta + type(psb_desc_type), intent(in) :: desc_a + character, optional, intent(in) :: trans + real(psb_spk_), optional, intent(inout),target :: work(:) + logical, optional, intent(in) :: doswap + integer, intent(out) :: info + end subroutine psb_sspmv_vect end interface interface psb_spsm @@ -249,7 +317,7 @@ module psb_s_psblas_mod integer, optional, intent(in) :: choice real(psb_spk_), optional, intent(in),target :: diag(:) real(psb_spk_), optional, intent(inout),target :: work(:) - integer, intent(out) :: info + integer, intent(out) :: info end subroutine psb_sspsm subroutine psb_sspsv(alpha, t, x, beta, y,& & desc_a, info, trans, scale, choice,& @@ -267,6 +335,23 @@ module psb_s_psblas_mod real(psb_spk_), optional, intent(inout), target :: work(:) integer, intent(out) :: info end subroutine psb_sspsv + subroutine psb_sspsv_vect(alpha, t, x, beta, y,& + & desc_a, info, trans, scale, choice,& + & diag, work) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + use psb_s_vect_mod, only : psb_s_vect_type + use psb_mat_mod, only : psb_sspmat_type + type(psb_sspmat_type), intent(inout) :: t + type(psb_s_vect_type), intent(inout) :: x + type(psb_s_vect_type), intent(inout) :: y + real(psb_spk_), intent(in) :: alpha, beta + type(psb_desc_type), intent(in) :: desc_a + character, optional, intent(in) :: trans, scale + integer, optional, intent(in) :: choice + type(psb_s_vect_type), intent(inout), optional :: diag + real(psb_spk_), optional, intent(inout), target :: work(:) + integer, intent(out) :: info + end subroutine psb_sspsv_vect end interface end module psb_s_psblas_mod diff --git a/base/modules/psb_s_tools_mod.f90 b/base/modules/psb_s_tools_mod.f90 index e2c1d8a15..79352a0d4 100644 --- a/base/modules/psb_s_tools_mod.f90 +++ b/base/modules/psb_s_tools_mod.f90 @@ -48,6 +48,22 @@ Module psb_s_tools_mod integer,intent(out) :: info integer, optional, intent(in) :: n end subroutine psb_sallocv + subroutine psb_salloc_vect(x, desc_a,info,n) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + use psb_s_vect_mod + type(psb_s_vect_type), intent(out) :: x + type(psb_desc_type), intent(in) :: desc_a + integer,intent(out) :: info + integer, optional, intent(in) :: n + end subroutine psb_salloc_vect + subroutine psb_salloc_vect_r2(x, desc_a,info,n,lb) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + use psb_s_vect_mod + type(psb_s_vect_type), allocatable, intent(out) :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer,intent(out) :: info + integer, optional, intent(in) :: n, lb + end subroutine psb_salloc_vect_r2 end interface @@ -64,6 +80,22 @@ Module psb_s_tools_mod real(psb_spk_), allocatable, intent(inout) :: x(:) integer, intent(out) :: info end subroutine psb_sasbv + subroutine psb_sasb_vect(x, desc_a, info,mold) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + use psb_s_vect_mod + type(psb_desc_type), intent(in) :: desc_a + type(psb_s_vect_type), intent(inout) :: x + integer, intent(out) :: info + class(psb_s_base_vect_type), intent(in), optional :: mold + end subroutine psb_sasb_vect + subroutine psb_sasb_vect_r2(x, desc_a, info,mold) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + use psb_s_vect_mod + type(psb_desc_type), intent(in) :: desc_a + type(psb_s_vect_type), intent(inout) :: x(:) + integer, intent(out) :: info + class(psb_s_base_vect_type), intent(in), optional :: mold + end subroutine psb_sasb_vect_r2 end interface interface psb_sphalo @@ -93,8 +125,22 @@ Module psb_s_tools_mod use psb_descriptor_type, only : psb_desc_type, psb_spk_ real(psb_spk_),allocatable, intent(inout) :: x(:) type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info + integer, intent(out) :: info end subroutine psb_sfreev + subroutine psb_sfree_vect(x, desc_a, info) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + use psb_s_vect_mod + type(psb_desc_type), intent(in) :: desc_a + type(psb_s_vect_type), intent(inout) :: x + integer, intent(out) :: info + end subroutine psb_sfree_vect + subroutine psb_sfree_vect_r2(x, desc_a, info) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + use psb_s_vect_mod + type(psb_desc_type), intent(in) :: desc_a + type(psb_s_vect_type), allocatable, intent(inout) :: x(:) + integer, intent(out) :: info + end subroutine psb_sfree_vect_r2 end interface @@ -119,6 +165,28 @@ Module psb_s_tools_mod integer, intent(out) :: info integer, optional, intent(in) :: dupl end subroutine psb_sinsvi + subroutine psb_sins_vect(m,irw,val,x,desc_a,info,dupl) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + use psb_s_vect_mod + integer, intent(in) :: m + type(psb_desc_type), intent(in) :: desc_a + type(psb_s_vect_type), intent(inout) :: x + integer, intent(in) :: irw(:) + real(psb_spk_), intent(in) :: val(:) + integer, intent(out) :: info + integer, optional, intent(in) :: dupl + end subroutine psb_sins_vect + subroutine psb_sins_vect_r2(m,irw,val,x,desc_a,info,dupl) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + use psb_s_vect_mod + integer, intent(in) :: m + type(psb_desc_type), intent(in) :: desc_a + type(psb_s_vect_type), intent(inout) :: x(:) + integer, intent(in) :: irw(:) + real(psb_spk_), intent(in) :: val(:,:) + integer, intent(out) :: info + integer, optional, intent(in) :: dupl + end subroutine psb_sins_vect_r2 end interface interface psb_cdbldext @@ -204,90 +272,5 @@ Module psb_s_tools_mod end subroutine psb_ssprn end interface -!!$ -!!$ interface psb_linmap_init -!!$ module procedure psb_slinmap_init -!!$ end interface -!!$ -!!$ interface psb_linmap_ins -!!$ module procedure psb_slinmap_ins -!!$ end interface -!!$ -!!$ interface psb_linmap_asb -!!$ module procedure psb_slinmap_asb -!!$ end interface -!!$ -!!$contains -!!$ -!!$ -!!$ subroutine psb_slinmap_init(a_map,cd_xt,descin,descout) -!!$ use psb_descriptor_type -!!$ use psb_serial_mod -!!$ use psb_penv_mod -!!$ use psb_error_mod -!!$ use psb_base_tools_mod -!!$ use psb_s_mat_mod -!!$ implicit none -!!$ type(psb_sspmat_type), intent(out) :: a_map -!!$ type(psb_desc_type), intent(out) :: cd_xt -!!$ type(psb_desc_type), intent(in) :: descin, descout -!!$ -!!$ integer :: nrow_in, nrow_out, ncol_in, info, ictxt -!!$ -!!$ ictxt = psb_cd_get_context(descin) -!!$ call psb_cdcpy(descin,cd_xt,info) -!!$ if (info == psb_success_) call psb_cd_reinit(cd_xt,info) -!!$ if (info /= psb_success_) then -!!$ write(psb_err_unit,*) 'Error on reinitialising the extension map' -!!$ call psb_error(ictxt) -!!$ call psb_abort(ictxt) -!!$ stop -!!$ end if -!!$ -!!$ nrow_in = psb_cd_get_local_rows(cd_xt) -!!$ ncol_in = psb_cd_get_local_cols(cd_xt) -!!$ nrow_out = psb_cd_get_local_rows(descout) -!!$ -!!$ call a_map%csall(nrow_out,ncol_in,info) -!!$ -!!$ end subroutine psb_slinmap_init -!!$ -!!$ subroutine psb_slinmap_ins(nz,ir,ic,val,a_map,cd_xt,descin,descout) -!!$ use psb_s_mat_mod -!!$ use psb_descriptor_type -!!$ implicit none -!!$ integer, intent(in) :: nz -!!$ integer, intent(in) :: ir(:),ic(:) -!!$ real(psb_spk_), intent(in) :: val(:) -!!$ type(psb_sspmat_type), intent(inout) :: a_map -!!$ type(psb_desc_type), intent(inout) :: cd_xt -!!$ type(psb_desc_type), intent(in) :: descin, descout -!!$ integer :: info -!!$ call psb_spins(nz,ir,ic,val,a_map,descout,cd_xt,info) -!!$ -!!$ end subroutine psb_slinmap_ins -!!$ -!!$ subroutine psb_slinmap_asb(a_map,cd_xt,descin,descout,afmt) -!!$ use psb_base_tools_mod -!!$ use psb_s_mat_mod -!!$ use psb_descriptor_type -!!$ use psb_serial_mod -!!$ implicit none -!!$ type(psb_sspmat_type), intent(inout) :: a_map -!!$ type(psb_desc_type), intent(inout) :: cd_xt -!!$ type(psb_desc_type), intent(in) :: descin, descout -!!$ character(len=*), optional, intent(in) :: afmt -!!$ -!!$ -!!$ integer :: nrow_in, nrow_out, ncol_in, info, ictxt -!!$ -!!$ ictxt = psb_cd_get_context(descin) -!!$ -!!$ call psb_cdasb(cd_xt,info) -!!$ call a_map%set_ncols(psb_cd_get_local_cols(cd_xt)) -!!$ call a_map%cscnv(info,type=afmt) -!!$ -!!$ end subroutine psb_slinmap_asb - end module psb_s_tools_mod diff --git a/base/modules/psb_s_vect_mod.f90 b/base/modules/psb_s_vect_mod.f90 new file mode 100644 index 000000000..56f205364 --- /dev/null +++ b/base/modules/psb_s_vect_mod.f90 @@ -0,0 +1,503 @@ +module psb_s_vect_mod + + use psb_s_base_vect_mod + + type psb_s_vect_type + class(psb_s_base_vect_type), allocatable :: v + contains + procedure, pass(x) :: get_nrows => s_vect_get_nrows + procedure, pass(x) :: dot_v => s_vect_dot_v + procedure, pass(x) :: dot_a => s_vect_dot_a + generic, public :: dot => dot_v, dot_a + procedure, pass(y) :: axpby_v => s_vect_axpby_v + procedure, pass(y) :: axpby_a => s_vect_axpby_a + generic, public :: axpby => axpby_v, axpby_a + procedure, pass(y) :: mlt_v => s_vect_mlt_v + procedure, pass(y) :: mlt_a => s_vect_mlt_a + procedure, pass(z) :: mlt_a_2 => s_vect_mlt_a_2 + procedure, pass(z) :: mlt_v_2 => s_vect_mlt_v_2 + procedure, pass(z) :: mlt_va => s_vect_mlt_va + procedure, pass(z) :: mlt_av => s_vect_mlt_av + generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,& + & mlt_v_2, mlt_av, mlt_va + procedure, pass(x) :: scal => s_vect_scal + procedure, pass(x) :: nrm2 => s_vect_nrm2 + procedure, pass(x) :: amax => s_vect_amax + procedure, pass(x) :: asum => s_vect_asum + procedure, pass(x) :: all => s_vect_all + procedure, pass(x) :: zero => s_vect_zero + procedure, pass(x) :: asb => s_vect_asb + procedure, pass(x) :: sync => s_vect_sync + procedure, pass(x) :: gthab => s_vect_gthab + procedure, pass(x) :: gthzv => s_vect_gthzv + generic, public :: gth => gthab, gthzv + procedure, pass(y) :: sctb => s_vect_sctb + generic, public :: sct => sctb + procedure, pass(x) :: free => s_vect_free + procedure, pass(x) :: ins => s_vect_ins + procedure, pass(x) :: bld_x => s_vect_bld_x + procedure, pass(x) :: bld_n => s_vect_bld_n + generic, public :: bld => bld_x, bld_n + procedure, pass(x) :: getCopy => s_vect_getCopy + procedure, pass(x) :: cpy_vect => s_vect_cpy_vect + generic, public :: assignment(=) => cpy_vect + procedure, pass(x) :: cnv => s_vect_cnv + procedure, pass(x) :: set_scal => s_vect_set_scal + procedure, pass(x) :: set_vect => s_vect_set_vect + generic, public :: set => set_vect, set_scal + end type psb_s_vect_type + + public :: psb_s_vect + private :: constructor, size_const + interface psb_s_vect + module procedure constructor, size_const + end interface psb_s_vect + +contains + + subroutine s_vect_bld_x(x,invect,mold) + real(psb_spk_), intent(in) :: invect(:) + class(psb_s_vect_type), intent(out) :: x + class(psb_s_base_vect_type), intent(in), optional :: mold + integer :: info + + if (present(mold)) then + allocate(x%v,stat=info,mold=mold) + else + allocate(psb_s_base_vect_type :: x%v,stat=info) + endif + + if (info == psb_success_) call x%v%bld(invect) + + end subroutine s_vect_bld_x + + + subroutine s_vect_bld_n(x,n,mold) + integer, intent(in) :: n + class(psb_s_vect_type), intent(out) :: x + class(psb_s_base_vect_type), intent(in), optional :: mold + integer :: info + + if (present(mold)) then + allocate(x%v,stat=info,mold=mold) + else + allocate(psb_s_base_vect_type :: x%v,stat=info) + endif + if (info == psb_success_) call x%v%bld(n) + + end subroutine s_vect_bld_n + + function s_vect_getCopy(x) result(res) + class(psb_s_vect_type), intent(in) :: x + real(psb_spk_), allocatable :: res(:) + integer :: info + + if (allocated(x%v)) res = x%v%getCopy() + + end function s_vect_getCopy + + subroutine s_vect_cpy_vect(res,x) + real(psb_spk_), allocatable, intent(out) :: res(:) + class(psb_s_vect_type), intent(in) :: x + integer :: info + + if (allocated(x%v)) res = x%v + + end subroutine s_vect_cpy_vect + + subroutine s_vect_set_scal(x,val) + class(psb_s_vect_type), intent(inout) :: x + real(psb_spk_), intent(in) :: val + + integer :: info + if (allocated(x%v)) call x%v%set(val) + + end subroutine s_vect_set_scal + + subroutine s_vect_set_vect(x,val) + class(psb_s_vect_type), intent(inout) :: x + real(psb_spk_), intent(in) :: val(:) + + integer :: info + if (allocated(x%v)) call x%v%set(val) + + end subroutine s_vect_set_vect + + + function constructor(x) result(this) + real(psb_spk_) :: x(:) + type(psb_s_vect_type) :: this + integer :: info + + allocate(psb_s_base_vect_type :: this%v, stat=info) + + if (info == 0) call this%v%bld(x) + + call this%asb(size(x),info) + + end function constructor + + + function size_const(n) result(this) + integer, intent(in) :: n + type(psb_s_vect_type) :: this + integer :: info + + allocate(psb_s_base_vect_type :: this%v, stat=info) + call this%asb(n,info) + + end function size_const + + + function s_vect_get_nrows(x) result(res) + implicit none + class(psb_s_vect_type), intent(in) :: x + integer :: res + res = -1 + if (allocated(x%v)) res = x%v%get_nrows() + end function s_vect_get_nrows + + function s_vect_dot_v(n,x,y) result(res) + implicit none + class(psb_s_vect_type), intent(inout) :: x, y + integer, intent(in) :: n + real(psb_spk_) :: res + + res = szero + if (allocated(x%v).and.allocated(y%v)) & + & res = x%v%dot(n,y%v) + + end function s_vect_dot_v + + function s_vect_dot_a(n,x,y) result(res) + implicit none + class(psb_s_vect_type), intent(inout) :: x + real(psb_spk_), intent(in) :: y(:) + integer, intent(in) :: n + real(psb_spk_) :: res + + res = szero + if (allocated(x%v)) & + & res = x%v%dot(n,y) + + end function s_vect_dot_a + + subroutine s_vect_axpby_v(m,alpha, x, beta, y, info) + use psi_serial_mod + implicit none + integer, intent(in) :: m + class(psb_s_vect_type), intent(inout) :: x + class(psb_s_vect_type), intent(inout) :: y + real(psb_spk_), intent (in) :: alpha, beta + integer, intent(out) :: info + + if (allocated(x%v).and.allocated(y%v)) then + call y%v%axpby(m,alpha,x%v,beta,info) + else + info = psb_err_invalid_vect_state_ + end if + + end subroutine s_vect_axpby_v + + subroutine s_vect_axpby_a(m,alpha, x, beta, y, info) + use psi_serial_mod + implicit none + integer, intent(in) :: m + real(psb_spk_), intent(in) :: x(:) + class(psb_s_vect_type), intent(inout) :: y + real(psb_spk_), intent (in) :: alpha, beta + integer, intent(out) :: info + + if (allocated(y%v)) & + & call y%v%axpby(m,alpha,x,beta,info) + + end subroutine s_vect_axpby_a + + + subroutine s_vect_mlt_v(x, y, info) + use psi_serial_mod + implicit none + class(psb_s_vect_type), intent(inout) :: x + class(psb_s_vect_type), intent(inout) :: y + integer, intent(out) :: info + integer :: i, n + + info = 0 + if (allocated(x%v).and.allocated(y%v)) & + & call y%v%mlt(x%v,info) + + end subroutine s_vect_mlt_v + + subroutine s_vect_mlt_a(x, y, info) + use psi_serial_mod + implicit none + real(psb_spk_), intent(in) :: x(:) + class(psb_s_vect_type), intent(inout) :: y + integer, intent(out) :: info + integer :: i, n + + + info = 0 + if (allocated(y%v)) & + & call y%v%mlt(x,info) + + end subroutine s_vect_mlt_a + + + subroutine s_vect_mlt_a_2(alpha,x,y,beta,z,info) + use psi_serial_mod + implicit none + real(psb_spk_), intent(in) :: alpha,beta + real(psb_spk_), intent(in) :: y(:) + real(psb_spk_), intent(in) :: x(:) + class(psb_s_vect_type), intent(inout) :: z + integer, intent(out) :: info + integer :: i, n + + info = 0 + if (allocated(z%v)) & + & call z%v%mlt(alpha,x,y,beta,info) + + end subroutine s_vect_mlt_a_2 + + subroutine s_vect_mlt_v_2(alpha,x,y,beta,z,info) + use psi_serial_mod + implicit none + real(psb_spk_), intent(in) :: alpha,beta + class(psb_s_vect_type), intent(inout) :: x + class(psb_s_vect_type), intent(inout) :: y + class(psb_s_vect_type), intent(inout) :: z + integer, intent(out) :: info + integer :: i, n + + info = 0 + if (allocated(x%v).and.allocated(y%v).and.& + & allocated(z%v)) & + & call z%v%mlt(alpha,x%v,y%v,beta,info) + + end subroutine s_vect_mlt_v_2 + + subroutine s_vect_mlt_av(alpha,x,y,beta,z,info) + use psi_serial_mod + implicit none + real(psb_spk_), intent(in) :: alpha,beta + real(psb_spk_), intent(in) :: x(:) + class(psb_s_vect_type), intent(inout) :: y + class(psb_s_vect_type), intent(inout) :: z + integer, intent(out) :: info + integer :: i, n + + info = 0 + if (allocated(z%v).and.allocated(y%v)) & + & call z%v%mlt(alpha,x,y%v,beta,info) + + end subroutine s_vect_mlt_av + + subroutine s_vect_mlt_va(alpha,x,y,beta,z,info) + use psi_serial_mod + implicit none + real(psb_spk_), intent(in) :: alpha,beta + real(psb_spk_), intent(in) :: y(:) + class(psb_s_vect_type), intent(inout) :: x + class(psb_s_vect_type), intent(inout) :: z + integer, intent(out) :: info + integer :: i, n + + info = 0 + + if (allocated(z%v).and.allocated(x%v)) & + & call z%v%mlt(alpha,x%v,y,beta,info) + + end subroutine s_vect_mlt_va + + subroutine s_vect_scal(alpha, x) + use psi_serial_mod + implicit none + class(psb_s_vect_type), intent(inout) :: x + real(psb_spk_), intent (in) :: alpha + + if (allocated(x%v)) call x%v%scal(alpha) + + end subroutine s_vect_scal + + + function s_vect_nrm2(n,x) result(res) + implicit none + class(psb_s_vect_type), intent(inout) :: x + integer, intent(in) :: n + real(psb_spk_) :: res + + if (allocated(x%v)) then + res = x%v%nrm2(n) + else + res = szero + end if + + end function s_vect_nrm2 + + function s_vect_amax(n,x) result(res) + implicit none + class(psb_s_vect_type), intent(inout) :: x + integer, intent(in) :: n + real(psb_spk_) :: res + + if (allocated(x%v)) then + res = x%v%amax(n) + else + res = szero + end if + + end function s_vect_amax + + function s_vect_asum(n,x) result(res) + implicit none + class(psb_s_vect_type), intent(inout) :: x + integer, intent(in) :: n + real(psb_spk_) :: res + + if (allocated(x%v)) then + res = x%v%asum(n) + else + res = szero + end if + + end function s_vect_asum + + subroutine s_vect_all(n, x, info, mold) + + implicit none + integer, intent(in) :: n + class(psb_s_vect_type), intent(out) :: x + class(psb_s_base_vect_type), intent(in), optional :: mold + integer, intent(out) :: info + + if (present(mold)) then + allocate(x%v,stat=info,mold=mold) + else + allocate(psb_s_base_vect_type :: x%v,stat=info) + endif + if (info == 0) then + call x%v%all(n,info) + else + info = psb_err_alloc_dealloc_ + end if + + end subroutine s_vect_all + + subroutine s_vect_zero(x) + use psi_serial_mod + implicit none + class(psb_s_vect_type), intent(inout) :: x + + if (allocated(x%v)) call x%v%zero() + + end subroutine s_vect_zero + + subroutine s_vect_asb(n, x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + integer, intent(in) :: n + class(psb_s_vect_type), intent(inout) :: x + integer, intent(out) :: info + + if (allocated(x%v)) & + & call x%v%asb(n,info) + + end subroutine s_vect_asb + + subroutine s_vect_sync(x) + implicit none + class(psb_s_vect_type), intent(inout) :: x + + if (allocated(x%v)) & + & call x%v%sync() + + end subroutine s_vect_sync + + subroutine s_vect_gthab(n,idx,alpha,x,beta,y) + use psi_serial_mod + integer :: n, idx(:) + real(psb_spk_) :: alpha, beta, y(:) + class(psb_s_vect_type) :: x + + if (allocated(x%v)) & + & call x%v%gth(n,idx,alpha,beta,y) + + end subroutine s_vect_gthab + + subroutine s_vect_gthzv(n,idx,x,y) + use psi_serial_mod + integer :: n, idx(:) + real(psb_spk_) :: y(:) + class(psb_s_vect_type) :: x + + if (allocated(x%v)) & + & call x%v%gth(n,idx,y) + + end subroutine s_vect_gthzv + + subroutine s_vect_sctb(n,idx,x,beta,y) + use psi_serial_mod + integer :: n, idx(:) + real(psb_spk_) :: beta, x(:) + class(psb_s_vect_type) :: y + + if (allocated(y%v)) & + & call y%v%sct(n,idx,x,beta) + + end subroutine s_vect_sctb + + subroutine s_vect_free(x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + class(psb_s_vect_type), intent(inout) :: x + integer, intent(out) :: info + + info = 0 + if (allocated(x%v)) then + call x%v%free(info) + if (info == 0) deallocate(x%v,stat=info) + end if + + end subroutine s_vect_free + + subroutine s_vect_ins(n,irl,val,dupl,x,info) + use psi_serial_mod + implicit none + class(psb_s_vect_type), intent(inout) :: x + integer, intent(in) :: n, dupl + integer, intent(in) :: irl(:) + real(psb_spk_), intent(in) :: val(:) + integer, intent(out) :: info + + integer :: i + + info = 0 + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + return + end if + + call x%v%ins(n,irl,val,dupl,info) + + end subroutine s_vect_ins + + + subroutine s_vect_cnv(x,mold) + class(psb_s_vect_type), intent(inout) :: x + class(psb_s_base_vect_type), intent(in) :: mold + class(psb_s_base_vect_type), allocatable :: tmp + real(psb_spk_), allocatable :: invect(:) + integer :: info + + allocate(tmp,stat=info,mold=mold) + call x%v%sync() + if (info == psb_success_) call tmp%bld(x%v%v) + call x%v%free(info) + call move_alloc(tmp,x%v) + + end subroutine s_vect_cnv + +end module psb_s_vect_mod diff --git a/base/modules/psb_serial_mod.f90 b/base/modules/psb_serial_mod.f90 index fb6d98f29..90418b85c 100644 --- a/base/modules/psb_serial_mod.f90 +++ b/base/modules/psb_serial_mod.f90 @@ -344,7 +344,7 @@ module psb_serial_mod use psb_const_mod integer, intent(in) :: nv1,nv2 integer, intent(in) :: iv1(*), iv2(*) - real(psb_dpk_), intent(in) :: v1(*),v2(*) + real(psb_dpk_), intent(in) :: v1(*), v2(*) real(psb_dpk_) :: dot end function psb_d_spdot_srtd diff --git a/base/modules/psb_vect_mod.f90 b/base/modules/psb_vect_mod.f90 new file mode 100644 index 000000000..31b357447 --- /dev/null +++ b/base/modules/psb_vect_mod.f90 @@ -0,0 +1,6 @@ +module psb_vect_mod + use psb_s_vect_mod + use psb_d_vect_mod + use psb_c_vect_mod + use psb_z_vect_mod +end module psb_vect_mod diff --git a/base/modules/psb_z_base_mat_mod.f90 b/base/modules/psb_z_base_mat_mod.f90 index 4569411df..b898d7395 100644 --- a/base/modules/psb_z_base_mat_mod.f90 +++ b/base/modules/psb_z_base_mat_mod.f90 @@ -59,22 +59,32 @@ module psb_z_base_mat_mod use psb_base_mat_mod + use psb_z_base_vect_mod type, extends(psb_base_sparse_mat) :: psb_z_base_sparse_mat contains + procedure, pass(a) :: z_sp_mv => psb_z_base_vect_mv procedure, pass(a) :: z_csmv => psb_z_base_csmv procedure, pass(a) :: z_csmm => psb_z_base_csmm - generic, public :: csmm => z_csmm, z_csmv + generic, public :: csmm => z_csmm, z_csmv, z_sp_mv + procedure, pass(a) :: z_in_sv => psb_z_base_inner_vect_sv procedure, pass(a) :: z_inner_cssv => psb_z_base_inner_cssv procedure, pass(a) :: z_inner_cssm => psb_z_base_inner_cssm - generic, public :: inner_cssm => z_inner_cssm, z_inner_cssv + generic, public :: inner_cssm => z_inner_cssm, z_inner_cssv, z_in_sv + procedure, pass(a) :: z_vect_cssv => psb_z_base_vect_cssv procedure, pass(a) :: z_cssv => psb_z_base_cssv procedure, pass(a) :: z_cssm => psb_z_base_cssm - generic, public :: cssm => z_cssm, z_cssv + generic, public :: cssm => z_cssm, z_cssv, z_vect_cssv procedure, pass(a) :: z_scals => psb_z_base_scals procedure, pass(a) :: z_scal => psb_z_base_scal generic, public :: scal => z_scals, z_scal + procedure, pass(a) :: maxval => psb_z_base_maxval procedure, pass(a) :: csnmi => psb_z_base_csnmi + procedure, pass(a) :: csnm1 => psb_z_base_csnm1 + procedure, pass(a) :: rowsum => psb_z_base_rowsum + procedure, pass(a) :: arwsum => psb_z_base_arwsum + procedure, pass(a) :: colsum => psb_z_base_colsum + procedure, pass(a) :: aclsum => psb_z_base_aclsum procedure, pass(a) :: get_diag => psb_z_base_get_diag procedure, pass(a) :: csput => psb_z_base_csput @@ -125,7 +135,13 @@ module psb_z_base_mat_mod procedure, pass(a) :: z_inner_cssv => psb_z_coo_cssv procedure, pass(a) :: z_scals => psb_z_coo_scals procedure, pass(a) :: z_scal => psb_z_coo_scal + procedure, pass(a) :: maxval => psb_z_coo_maxval procedure, pass(a) :: csnmi => psb_z_coo_csnmi + procedure, pass(a) :: csnm1 => psb_z_coo_csnm1 + procedure, pass(a) :: rowsum => psb_z_coo_rowsum + procedure, pass(a) :: arwsum => psb_z_coo_arwsum + procedure, pass(a) :: colsum => psb_z_coo_colsum + procedure, pass(a) :: aclsum => psb_z_coo_aclsum procedure, pass(a) :: reallocate_nz => psb_z_coo_reallocate_nz procedure, pass(a) :: allocate_mnnz => psb_z_coo_allocate_mnnz procedure, pass(a) :: cp_to_coo => psb_z_cp_coo_to_coo @@ -191,6 +207,18 @@ module psb_z_base_mat_mod end subroutine psb_z_base_csmv end interface + interface + subroutine psb_z_base_vect_mv(alpha,a,x,beta,y,info,trans) + import :: psb_z_base_sparse_mat, psb_dpk_, psb_z_base_vect_type + class(psb_z_base_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta + class(psb_z_base_vect_type), intent(inout) :: x + class(psb_z_base_vect_type), intent(inout) :: y + integer, intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_base_vect_mv + end interface + interface subroutine psb_z_base_inner_cssm(alpha,a,x,beta,y,info,trans) import :: psb_z_base_sparse_mat, psb_dpk_ @@ -213,6 +241,17 @@ module psb_z_base_mat_mod end subroutine psb_z_base_inner_cssv end interface + interface + subroutine psb_z_base_inner_vect_sv(alpha,a,x,beta,y,info,trans) + import :: psb_z_base_sparse_mat, psb_dpk_, psb_z_base_vect_type + class(psb_z_base_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta + class(psb_z_base_vect_type), intent(inout) :: x, y + integer, intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_base_inner_vect_sv + end interface + interface subroutine psb_z_base_cssm(alpha,a,x,beta,y,info,trans,scale,d) import :: psb_z_base_sparse_mat, psb_dpk_ @@ -237,6 +276,18 @@ module psb_z_base_mat_mod end subroutine psb_z_base_cssv end interface + interface + subroutine psb_z_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d) + import :: psb_z_base_sparse_mat, psb_dpk_,psb_z_base_vect_type + class(psb_z_base_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta + class(psb_z_base_vect_type), intent(inout) :: x,y + integer, intent(out) :: info + character, optional, intent(in) :: trans, scale + class(psb_z_base_vect_type), optional, intent(inout) :: d + end subroutine psb_z_base_vect_cssv + end interface + interface subroutine psb_z_base_scals(d,a,info) import :: psb_z_base_sparse_mat, psb_dpk_ @@ -255,6 +306,14 @@ module psb_z_base_mat_mod end subroutine psb_z_base_scal end interface + interface + function psb_z_base_maxval(a) result(res) + import :: psb_z_base_sparse_mat, psb_dpk_ + class(psb_z_base_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + end function psb_z_base_maxval + end interface + interface function psb_z_base_csnmi(a) result(res) import :: psb_z_base_sparse_mat, psb_dpk_ @@ -263,6 +322,46 @@ module psb_z_base_mat_mod end function psb_z_base_csnmi end interface + interface + function psb_z_base_csnm1(a) result(res) + import :: psb_z_base_sparse_mat, psb_dpk_ + class(psb_z_base_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + end function psb_z_base_csnm1 + end interface + + interface + subroutine psb_z_base_rowsum(d,a) + import :: psb_z_base_sparse_mat, psb_dpk_ + class(psb_z_base_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(out) :: d(:) + end subroutine psb_z_base_rowsum + end interface + + interface + subroutine psb_z_base_arwsum(d,a) + import :: psb_z_base_sparse_mat, psb_dpk_ + class(psb_z_base_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + end subroutine psb_z_base_arwsum + end interface + + interface + subroutine psb_z_base_colsum(d,a) + import :: psb_z_base_sparse_mat, psb_dpk_ + class(psb_z_base_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(out) :: d(:) + end subroutine psb_z_base_colsum + end interface + + interface + subroutine psb_z_base_aclsum(d,a) + import :: psb_z_base_sparse_mat, psb_dpk_ + class(psb_z_base_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + end subroutine psb_z_base_aclsum + end interface + interface subroutine psb_z_base_get_diag(a,d,info) import :: psb_z_base_sparse_mat, psb_dpk_ @@ -704,8 +803,15 @@ module psb_z_base_mat_mod character, optional, intent(in) :: trans end subroutine psb_z_coo_csmm end interface - - + + interface + function psb_z_coo_maxval(a) result(res) + import :: psb_z_coo_sparse_mat, psb_dpk_ + class(psb_z_coo_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + end function psb_z_coo_maxval + end interface + interface function psb_z_coo_csnmi(a) result(res) import :: psb_z_coo_sparse_mat, psb_dpk_ @@ -714,6 +820,46 @@ module psb_z_base_mat_mod end function psb_z_coo_csnmi end interface + interface + function psb_z_coo_csnm1(a) result(res) + import :: psb_z_coo_sparse_mat, psb_dpk_ + class(psb_z_coo_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + end function psb_z_coo_csnm1 + end interface + + interface + subroutine psb_z_coo_rowsum(d,a) + import :: psb_z_coo_sparse_mat, psb_dpk_ + class(psb_z_coo_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(out) :: d(:) + end subroutine psb_z_coo_rowsum + end interface + + interface + subroutine psb_z_coo_arwsum(d,a) + import :: psb_z_coo_sparse_mat, psb_dpk_ + class(psb_z_coo_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + end subroutine psb_z_coo_arwsum + end interface + + interface + subroutine psb_z_coo_colsum(d,a) + import :: psb_z_coo_sparse_mat, psb_dpk_ + class(psb_z_coo_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(out) :: d(:) + end subroutine psb_z_coo_colsum + end interface + + interface + subroutine psb_z_coo_aclsum(d,a) + import :: psb_z_coo_sparse_mat, psb_dpk_ + class(psb_z_coo_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + end subroutine psb_z_coo_aclsum + end interface + interface subroutine psb_z_coo_get_diag(a,d,info) import :: psb_z_coo_sparse_mat, psb_dpk_ diff --git a/base/modules/psb_z_base_vect_mod.f90 b/base/modules/psb_z_base_vect_mod.f90 new file mode 100644 index 000000000..f53595dbc --- /dev/null +++ b/base/modules/psb_z_base_vect_mod.f90 @@ -0,0 +1,578 @@ +module psb_z_base_vect_mod + + use psb_const_mod + use psb_error_mod + + type psb_z_base_vect_type + complex(psb_dpk_), allocatable :: v(:) + contains + procedure, pass(x) :: get_nrows => z_base_get_nrows + procedure, pass(x) :: dot_v => z_base_dot_v + procedure, pass(x) :: dot_a => z_base_dot_a + generic, public :: dot => dot_v, dot_a + procedure, pass(y) :: axpby_v => z_base_axpby_v + procedure, pass(y) :: axpby_a => z_base_axpby_a + generic, public :: axpby => axpby_v, axpby_a + procedure, pass(y) :: mlt_v => z_base_mlt_v + procedure, pass(y) :: mlt_a => z_base_mlt_a + procedure, pass(z) :: mlt_a_2 => z_base_mlt_a_2 + procedure, pass(z) :: mlt_v_2 => z_base_mlt_v_2 + procedure, pass(z) :: mlt_va => z_base_mlt_va + procedure, pass(z) :: mlt_av => z_base_mlt_av + generic, public :: mlt => mlt_v, mlt_a, mlt_a_2, mlt_v_2, mlt_av, mlt_va + procedure, pass(x) :: scal => z_base_scal + procedure, pass(x) :: nrm2 => z_base_nrm2 + procedure, pass(x) :: amax => z_base_amax + procedure, pass(x) :: asum => z_base_asum + procedure, pass(x) :: all => z_base_all + procedure, pass(x) :: zero => z_base_zero + procedure, pass(x) :: asb => z_base_asb + procedure, pass(x) :: sync => z_base_sync + procedure, pass(x) :: gthab => z_base_gthab + procedure, pass(x) :: gthzv => z_base_gthzv + generic, public :: gth => gthab, gthzv + procedure, pass(y) :: sctb => z_base_sctb + generic, public :: sct => sctb + procedure, pass(x) :: free => z_base_free + procedure, pass(x) :: ins => z_base_ins + procedure, pass(x) :: bld_x => z_base_bld_x + procedure, pass(x) :: bld_n => z_base_bld_n + generic, public :: bld => bld_x, bld_n + procedure, pass(x) :: getCopy => z_base_getCopy + procedure, pass(x) :: cpy_vect => z_base_cpy_vect + generic, public :: assignment(=) => cpy_vect, set_scal + procedure, pass(x) :: set_scal => z_base_set_scal + procedure, pass(x) :: set_vect => z_base_set_vect + generic, public :: set => set_vect, set_scal + end type psb_z_base_vect_type + + public :: psb_z_base_vect + private :: constructor, size_const + interface psb_z_base_vect + module procedure constructor, size_const + end interface psb_z_base_vect + +contains + + subroutine z_base_bld_x(x,this) + use psb_realloc_mod + complex(psb_dpk_), intent(in) :: this(:) + class(psb_z_base_vect_type), intent(inout) :: x + integer :: info + + call psb_realloc(size(this),x%v,info) + if (info /= 0) then + call psb_errpush(psb_err_alloc_dealloc_,'base_vect_bld') + return + end if + x%v(:) = this(:) + + end subroutine z_base_bld_x + + + subroutine z_base_bld_n(x,n) + integer, intent(in) :: n + class(psb_z_base_vect_type), intent(inout) :: x + integer :: info + + call x%asb(n,info) + + end subroutine z_base_bld_n + + function z_base_getCopy(x) result(res) + class(psb_z_base_vect_type), intent(in) :: x + complex(psb_dpk_), allocatable :: res(:) + integer :: info + + allocate(res(x%get_nrows()),stat=info) + if (info /= 0) then + call psb_errpush(psb_err_alloc_dealloc_,'base_getCopy') + return + end if + res(:) = x%v(:) + end function z_base_getCopy + + subroutine z_base_cpy_vect(res,x) + complex(psb_dpk_), allocatable, intent(out) :: res(:) + class(psb_z_base_vect_type), intent(in) :: x + integer :: info + + res = x%v + + end subroutine z_base_cpy_vect + + subroutine z_base_set_scal(x,val) + class(psb_z_base_vect_type), intent(inout) :: x + complex(psb_dpk_), intent(in) :: val + + integer :: info + x%v = val + + end subroutine z_base_set_scal + + subroutine z_base_set_vect(x,val) + class(psb_z_base_vect_type), intent(inout) :: x + complex(psb_dpk_), intent(in) :: val(:) + + integer :: info + x%v = val + + end subroutine z_base_set_vect + + + function constructor(x) result(this) + complex(psb_dpk_) :: x(:) + type(psb_z_base_vect_type) :: this + integer :: info + + this%v = x + call this%asb(size(x),info) + end function constructor + + + function size_const(n) result(this) + integer, intent(in) :: n + type(psb_z_base_vect_type) :: this + integer :: info + + call this%asb(n,info) + + end function size_const + + + function z_base_get_nrows(x) result(res) + implicit none + class(psb_z_base_vect_type), intent(in) :: x + integer :: res + res = -1 + if (allocated(x%v)) res = size(x%v) + end function z_base_get_nrows + + function z_base_dot_v(n,x,y) result(res) + implicit none + class(psb_z_base_vect_type), intent(inout) :: x, y + integer, intent(in) :: n + complex(psb_dpk_) :: res + complex(psb_dpk_), external :: zdotc + + res = zzero + ! + ! Note: this is the base implementation. + ! When we get here, we are sure that X is of + ! TYPE psb_z_base_vect + ! + select type(yy => y) + type is (psb_z_base_vect_type) + res = zdotc(n,x%v,1,y%v,1) + class default + res = y%dot(n,x%v) + end select + + end function z_base_dot_v + + function z_base_dot_a(n,x,y) result(res) + implicit none + class(psb_z_base_vect_type), intent(inout) :: x + complex(psb_dpk_), intent(in) :: y(:) + integer, intent(in) :: n + complex(psb_dpk_) :: res + complex(psb_dpk_), external :: zdotc + + res = zdotc(n,y,1,x%v,1) + + end function z_base_dot_a + + subroutine z_base_axpby_v(m,alpha, x, beta, y, info) + use psi_serial_mod + implicit none + integer, intent(in) :: m + class(psb_z_base_vect_type), intent(inout) :: x + class(psb_z_base_vect_type), intent(inout) :: y + complex(psb_dpk_), intent (in) :: alpha, beta + integer, intent(out) :: info + + select type(xx => x) + type is (psb_z_base_vect_type) + call psb_geaxpby(m,alpha,x%v,beta,y%v,info) + class default + call y%axpby(m,alpha,x%v,beta,info) + end select + + end subroutine z_base_axpby_v + + subroutine z_base_axpby_a(m,alpha, x, beta, y, info) + use psi_serial_mod + implicit none + integer, intent(in) :: m + complex(psb_dpk_), intent(in) :: x(:) + class(psb_z_base_vect_type), intent(inout) :: y + complex(psb_dpk_), intent (in) :: alpha, beta + integer, intent(out) :: info + + call psb_geaxpby(m,alpha,x,beta,y%v,info) + + end subroutine z_base_axpby_a + + + subroutine z_base_mlt_v(x, y, info) + use psi_serial_mod + implicit none + class(psb_z_base_vect_type), intent(inout) :: x + class(psb_z_base_vect_type), intent(inout) :: y + integer, intent(out) :: info + integer :: i, n + + info = 0 + select type(xx => x) + type is (psb_z_base_vect_type) + n = min(size(y%v), size(xx%v)) + do i=1, n + y%v(i) = y%v(i)*xx%v(i) + end do + class default + call y%mlt(x%v,info) + end select + + end subroutine z_base_mlt_v + + subroutine z_base_mlt_a(x, y, info) + use psi_serial_mod + implicit none + complex(psb_dpk_), intent(in) :: x(:) + class(psb_z_base_vect_type), intent(inout) :: y + integer, intent(out) :: info + integer :: i, n + + info = 0 + n = min(size(y%v), size(x)) + do i=1, n + y%v(i) = y%v(i)*x(i) + end do + + end subroutine z_base_mlt_a + + + subroutine z_base_mlt_a_2(alpha,x,y,beta,z,info) + use psi_serial_mod + implicit none + complex(psb_dpk_), intent(in) :: alpha,beta + complex(psb_dpk_), intent(in) :: y(:) + complex(psb_dpk_), intent(in) :: x(:) + class(psb_z_base_vect_type), intent(inout) :: z + integer, intent(out) :: info + integer :: i, n + + info = 0 + n = min(size(z%v), size(x), size(y)) +!!$ write(0,*) 'Mlt_a_2: ',n + if (alpha == zzero) then + if (beta == zone) then + return + else + do i=1, n + z%v(i) = beta*z%v(i) + end do + end if + else + if (alpha == zone) then + if (beta == zzero) then + do i=1, n + z%v(i) = y(i)*x(i) + end do + else if (beta == zone) then + do i=1, n + z%v(i) = z%v(i) + y(i)*x(i) + end do + else + do i=1, n + z%v(i) = beta*z%v(i) + y(i)*x(i) + end do + end if + else if (alpha == -zone) then + if (beta == zzero) then + do i=1, n + z%v(i) = -y(i)*x(i) + end do + else if (beta == zone) then + do i=1, n + z%v(i) = z%v(i) - y(i)*x(i) + end do + else + do i=1, n + z%v(i) = beta*z%v(i) - y(i)*x(i) + end do + end if + else + if (beta == zzero) then + do i=1, n + z%v(i) = alpha*y(i)*x(i) + end do + else if (beta == zone) then + do i=1, n + z%v(i) = z%v(i) + alpha*y(i)*x(i) + end do + else + do i=1, n + z%v(i) = beta*z%v(i) + alpha*y(i)*x(i) + end do + end if + end if + end if + end subroutine z_base_mlt_a_2 + + subroutine z_base_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy) + use psi_serial_mod + use psb_string_mod + implicit none + complex(psb_dpk_), intent(in) :: alpha,beta + class(psb_z_base_vect_type), intent(inout) :: x + class(psb_z_base_vect_type), intent(inout) :: y + class(psb_z_base_vect_type), intent(inout) :: z + integer, intent(out) :: info + character(len=1), intent(in), optional :: conjgx, conjgy + integer :: i, n + + info = 0 + if (present(conjgx)) then + if (psb_toupper(conjgx)=='C') x%v=conjg(x%v) + end if + if (present(conjgy)) then + if (psb_toupper(conjgy)=='C') y%v=conjg(y%v) + end if + call z%mlt(alpha,x%v,y%v,beta,info) + if (present(conjgx)) then + if (psb_toupper(conjgx)=='C') x%v=conjg(x%v) + end if + if (present(conjgy)) then + if (psb_toupper(conjgy)=='C') y%v=conjg(y%v) + end if + + end subroutine z_base_mlt_v_2 + + subroutine z_base_mlt_av(alpha,x,y,beta,z,info) + use psi_serial_mod + implicit none + complex(psb_dpk_), intent(in) :: alpha,beta + complex(psb_dpk_), intent(in) :: x(:) + class(psb_z_base_vect_type), intent(inout) :: y + class(psb_z_base_vect_type), intent(inout) :: z + integer, intent(out) :: info + integer :: i, n + + info = 0 + + call z%mlt(alpha,x,y%v,beta,info) + + end subroutine z_base_mlt_av + + subroutine z_base_mlt_va(alpha,x,y,beta,z,info) + use psi_serial_mod + implicit none + complex(psb_dpk_), intent(in) :: alpha,beta + complex(psb_dpk_), intent(in) :: y(:) + class(psb_z_base_vect_type), intent(inout) :: x + class(psb_z_base_vect_type), intent(inout) :: z + integer, intent(out) :: info + integer :: i, n + + info = 0 + + call z%mlt(alpha,y,x,beta,info) + + end subroutine z_base_mlt_va + + subroutine z_base_scal(alpha, x) + use psi_serial_mod + implicit none + class(psb_z_base_vect_type), intent(inout) :: x + complex(psb_dpk_), intent (in) :: alpha + + if (allocated(x%v)) x%v = alpha*x%v + + end subroutine z_base_scal + + + function z_base_nrm2(n,x) result(res) + implicit none + class(psb_z_base_vect_type), intent(inout) :: x + integer, intent(in) :: n + real(psb_dpk_) :: res + real(psb_dpk_), external :: dznrm2 + + res = dznrm2(n,x%v,1) + + end function z_base_nrm2 + + function z_base_amax(n,x) result(res) + implicit none + class(psb_z_base_vect_type), intent(inout) :: x + integer, intent(in) :: n + real(psb_dpk_) :: res + + res = maxval(abs(x%v(1:n))) + + end function z_base_amax + + function z_base_asum(n,x) result(res) + implicit none + class(psb_z_base_vect_type), intent(inout) :: x + integer, intent(in) :: n + real(psb_dpk_) :: res + + res = sum(abs(x%v(1:n))) + + end function z_base_asum + + subroutine z_base_all(n, x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + integer, intent(in) :: n + class(psb_z_base_vect_type), intent(out) :: x + integer, intent(out) :: info + + call psb_realloc(n,x%v,info) + + end subroutine z_base_all + + subroutine z_base_zero(x) + use psi_serial_mod + implicit none + class(psb_z_base_vect_type), intent(inout) :: x + + if (allocated(x%v)) x%v=zzero + + end subroutine z_base_zero + + subroutine z_base_asb(n, x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + integer, intent(in) :: n + class(psb_z_base_vect_type), intent(inout) :: x + integer, intent(out) :: info + + if (x%get_nrows() < n) & + & call psb_realloc(n,x%v,info) + if (info /= 0) & + & call psb_errpush(psb_err_alloc_dealloc_,'vect_asb') + + end subroutine z_base_asb + + subroutine z_base_sync(x) + implicit none + class(psb_z_base_vect_type), intent(inout) :: x + + ! + ! The base version does nothing, it's just + ! a placeholder. + ! + + end subroutine z_base_sync + + subroutine z_base_gthab(n,idx,alpha,x,beta,y) + use psi_serial_mod + integer :: n, idx(:) + complex(psb_dpk_) :: alpha, beta, y(:) + class(psb_z_base_vect_type) :: x + + call x%sync() + call psi_gth(n,idx,alpha,x%v,beta,y) + + end subroutine z_base_gthab + + subroutine z_base_gthzv(n,idx,x,y) + use psi_serial_mod + integer :: n, idx(:) + complex(psb_dpk_) :: y(:) + class(psb_z_base_vect_type) :: x + + call x%sync() + call psi_gth(n,idx,x%v,y) + + end subroutine z_base_gthzv + + subroutine z_base_sctb(n,idx,x,beta,y) + use psi_serial_mod + integer :: n, idx(:) + complex(psb_dpk_) :: beta, x(:) + class(psb_z_base_vect_type) :: y + + call y%sync() + call psi_sct(n,idx,x,beta,y%v) + + end subroutine z_base_sctb + + subroutine z_base_free(x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + class(psb_z_base_vect_type), intent(inout) :: x + integer, intent(out) :: info + + info = 0 + if (allocated(x%v)) deallocate(x%v, stat=info) + if (info /= 0) call & + & psb_errpush(psb_err_alloc_dealloc_,'vect_free') + + end subroutine z_base_free + + subroutine z_base_ins(n,irl,val,dupl,x,info) + use psi_serial_mod + implicit none + class(psb_z_base_vect_type), intent(inout) :: x + integer, intent(in) :: n, dupl + integer, intent(in) :: irl(:) + complex(psb_dpk_), intent(in) :: val(:) + integer, intent(out) :: info + + integer :: i + + info = 0 + if (psb_errstatus_fatal()) return + + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + else if (n > min(size(irl),size(val))) then + info = psb_err_invalid_input_ + + else + select case(dupl) + case(psb_dupl_ovwrt_) + do i = 1, n + !loop over all val's rows + + ! row actual block row + if (irl(i) > 0) then + ! this row belongs to me + ! copy i-th row of block val in x + x%v(irl(i)) = val(i) + end if + enddo + + case(psb_dupl_add_) + + do i = 1, n + !loop over all val's rows + + if (irl(i) > 0) then + ! this row belongs to me + ! copy i-th row of block val in x + x%v(irl(i)) = x%v(irl(i)) + val(i) + end if + enddo + + case default + info = 321 +!!$ call psb_errpush(info,name) +!!$ goto 9999 + end select + end if + if (info /= 0) then + call psb_errpush(info,'base_vect_ins') + return + end if + + end subroutine z_base_ins + +end module psb_z_base_vect_mod diff --git a/base/modules/psb_z_comm_mod.f90 b/base/modules/psb_z_comm_mod.f90 new file mode 100644 index 000000000..c496fecc8 --- /dev/null +++ b/base/modules/psb_z_comm_mod.f90 @@ -0,0 +1,155 @@ +!!$ +!!$ Parallel Sparse BLAS version 3.0 +!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +module psb_z_comm_mod + + interface psb_ovrl + subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,update,mode) + use psb_descriptor_type + complex(psb_dpk_), intent(inout), target :: x(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + complex(psb_dpk_), intent(inout), optional, target :: work(:) + integer, intent(in), optional :: update,jx,ik,mode + end subroutine psb_zovrlm + subroutine psb_zovrlv(x,desc_a,info,work,update,mode) + use psb_descriptor_type + complex(psb_dpk_), intent(inout), target :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + complex(psb_dpk_), intent(inout), optional, target :: work(:) + integer, intent(in), optional :: update,mode + end subroutine psb_zovrlv + subroutine psb_zovrl_vect(x,desc_a,info,work,update,mode) + use psb_descriptor_type + use psb_z_vect_mod + type(psb_z_vect_type), intent(inout) :: x + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + complex(psb_dpk_), intent(inout), optional, target :: work(:) + integer, intent(in), optional :: update,mode + end subroutine psb_zovrl_vect + end interface psb_ovrl + + interface psb_halo + subroutine psb_zhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data) + use psb_descriptor_type + complex(psb_dpk_), intent(inout), target :: x(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + complex(psb_dpk_), intent(in), optional :: alpha + complex(psb_dpk_), target, optional, intent(inout) :: work(:) + integer, intent(in), optional :: mode,jx,ik,data + character, intent(in), optional :: tran + end subroutine psb_zhalom + subroutine psb_zhalov(x,desc_a,info,alpha,work,tran,mode,data) + use psb_descriptor_type + complex(psb_dpk_), intent(inout) :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + complex(psb_dpk_), intent(in), optional :: alpha + complex(psb_dpk_), target, optional, intent(inout) :: work(:) + integer, intent(in), optional :: mode,data + character, intent(in), optional :: tran + end subroutine psb_zhalov + subroutine psb_zhalo_vect(x,desc_a,info,alpha,work,tran,mode,data) + use psb_descriptor_type + use psb_z_vect_mod + type(psb_z_vect_type), intent(inout) :: x + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + complex(psb_dpk_), intent(in), optional :: alpha + complex(psb_dpk_), target, optional, intent(inout) :: work(:) + integer, intent(in), optional :: mode,data + character, intent(in), optional :: tran + end subroutine psb_zhalo_vect + end interface psb_halo + + + interface psb_scatter + subroutine psb_zscatterm(globx, locx, desc_a, info, root) + use psb_descriptor_type + complex(psb_dpk_), intent(out) :: locx(:,:) + complex(psb_dpk_), intent(in) :: globx(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, intent(in), optional :: root + end subroutine psb_zscatterm + subroutine psb_zscatterv(globx, locx, desc_a, info, root) + use psb_descriptor_type + complex(psb_dpk_), intent(out) :: locx(:) + complex(psb_dpk_), intent(in) :: globx(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, intent(in), optional :: root + end subroutine psb_zscatterv + end interface + + interface psb_gather + subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) + use psb_descriptor_type + use psb_mat_mod + implicit none + type(psb_zspmat_type), intent(inout) :: loca + type(psb_zspmat_type), intent(out) :: globa + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, intent(in), optional :: root,dupl + logical, intent(in), optional :: keepnum,keeploc + end subroutine psb_zsp_allgather + subroutine psb_zgatherm(globx, locx, desc_a, info, root) + use psb_descriptor_type + complex(psb_dpk_), intent(in) :: locx(:,:) + complex(psb_dpk_), intent(out) :: globx(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, intent(in), optional :: root + end subroutine psb_zgatherm + subroutine psb_zgatherv(globx, locx, desc_a, info, root) + use psb_descriptor_type + complex(psb_dpk_), intent(in) :: locx(:) + complex(psb_dpk_), intent(out) :: globx(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, intent(in), optional :: root + end subroutine psb_zgatherv + subroutine psb_zgather_vect(globx, locx, desc_a, info, root) + use psb_descriptor_type + use psb_z_vect_mod + type(psb_z_vect_type), intent(in) :: locx + complex(psb_dpk_), intent(out) :: globx(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, intent(in), optional :: root + end subroutine psb_zgather_vect + end interface psb_gather + +end module psb_z_comm_mod diff --git a/base/modules/psb_z_csc_mat_mod.f90 b/base/modules/psb_z_csc_mat_mod.f90 index aca70aab3..3fabe8c5e 100644 --- a/base/modules/psb_z_csc_mat_mod.f90 +++ b/base/modules/psb_z_csc_mat_mod.f90 @@ -58,7 +58,13 @@ module psb_z_csc_mat_mod procedure, pass(a) :: z_inner_cssv => psb_z_csc_cssv procedure, pass(a) :: z_scals => psb_z_csc_scals procedure, pass(a) :: z_scal => psb_z_csc_scal + procedure, pass(a) :: maxval => psb_z_csc_maxval procedure, pass(a) :: csnmi => psb_z_csc_csnmi + procedure, pass(a) :: csnm1 => psb_z_csc_csnm1 + procedure, pass(a) :: rowsum => psb_z_csc_rowsum + procedure, pass(a) :: arwsum => psb_z_csc_arwsum + procedure, pass(a) :: colsum => psb_z_csc_colsum + procedure, pass(a) :: aclsum => psb_z_csc_aclsum procedure, pass(a) :: reallocate_nz => psb_z_csc_reallocate_nz procedure, pass(a) :: allocate_mnnz => psb_z_csc_allocate_mnnz procedure, pass(a) :: cp_to_coo => psb_z_cp_csc_to_coo @@ -330,6 +336,14 @@ module psb_z_csc_mat_mod end interface + interface + function psb_z_csc_maxval(a) result(res) + import :: psb_z_csc_sparse_mat, psb_dpk_ + class(psb_z_csc_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + end function psb_z_csc_maxval + end interface + interface function psb_z_csc_csnmi(a) result(res) import :: psb_z_csc_sparse_mat, psb_dpk_ @@ -338,6 +352,46 @@ module psb_z_csc_mat_mod end function psb_z_csc_csnmi end interface + interface + function psb_z_csc_csnm1(a) result(res) + import :: psb_z_csc_sparse_mat, psb_dpk_ + class(psb_z_csc_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + end function psb_z_csc_csnm1 + end interface + + interface + subroutine psb_z_csc_rowsum(d,a) + import :: psb_z_csc_sparse_mat, psb_dpk_ + class(psb_z_csc_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(out) :: d(:) + end subroutine psb_z_csc_rowsum + end interface + + interface + subroutine psb_z_csc_arwsum(d,a) + import :: psb_z_csc_sparse_mat, psb_dpk_ + class(psb_z_csc_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + end subroutine psb_z_csc_arwsum + end interface + + interface + subroutine psb_z_csc_colsum(d,a) + import :: psb_z_csc_sparse_mat, psb_dpk_ + class(psb_z_csc_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(out) :: d(:) + end subroutine psb_z_csc_colsum + end interface + + interface + subroutine psb_z_csc_aclsum(d,a) + import :: psb_z_csc_sparse_mat, psb_dpk_ + class(psb_z_csc_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + end subroutine psb_z_csc_aclsum + end interface + interface subroutine psb_z_csc_get_diag(a,d,info) import :: psb_z_csc_sparse_mat, psb_dpk_ diff --git a/base/modules/psb_z_csr_mat_mod.f90 b/base/modules/psb_z_csr_mat_mod.f90 index 0bc1b8015..edff24b1b 100644 --- a/base/modules/psb_z_csr_mat_mod.f90 +++ b/base/modules/psb_z_csr_mat_mod.f90 @@ -58,7 +58,13 @@ module psb_z_csr_mat_mod procedure, pass(a) :: z_inner_cssv => psb_z_csr_cssv procedure, pass(a) :: z_scals => psb_z_csr_scals procedure, pass(a) :: z_scal => psb_z_csr_scal + procedure, pass(a) :: maxval => psb_z_csr_maxval procedure, pass(a) :: csnmi => psb_z_csr_csnmi + procedure, pass(a) :: csnm1 => psb_z_csr_csnm1 + procedure, pass(a) :: rowsum => psb_z_csr_rowsum + procedure, pass(a) :: arwsum => psb_z_csr_arwsum + procedure, pass(a) :: colsum => psb_z_csr_colsum + procedure, pass(a) :: aclsum => psb_z_csr_aclsum procedure, pass(a) :: reallocate_nz => psb_z_csr_reallocate_nz procedure, pass(a) :: allocate_mnnz => psb_z_csr_allocate_mnnz procedure, pass(a) :: cp_to_coo => psb_z_cp_csr_to_coo @@ -112,15 +118,6 @@ module psb_z_csr_mat_mod end subroutine psb_z_csr_trim end interface - interface - subroutine psb_z_csr_allocate_mnnz(m,n,a,nz) - import :: psb_z_csr_sparse_mat - integer, intent(in) :: m,n - class(psb_z_csr_sparse_mat), intent(inout) :: a - integer, intent(in), optional :: nz - end subroutine psb_z_csr_allocate_mnnz - end interface - interface subroutine psb_z_csr_mold(a,b,info) import :: psb_z_csr_sparse_mat, psb_z_base_sparse_mat, psb_long_int_k_ @@ -129,7 +126,16 @@ module psb_z_csr_mat_mod integer, intent(out) :: info end subroutine psb_z_csr_mold end interface - + + interface + subroutine psb_z_csr_allocate_mnnz(m,n,a,nz) + import :: psb_z_csr_sparse_mat + integer, intent(in) :: m,n + class(psb_z_csr_sparse_mat), intent(inout) :: a + integer, intent(in), optional :: nz + end subroutine psb_z_csr_allocate_mnnz + end interface + interface subroutine psb_z_csr_print(iout,a,iv,eirs,eics,head,ivr,ivc) import :: psb_z_csr_sparse_mat @@ -330,6 +336,14 @@ module psb_z_csr_mat_mod end interface + interface + function psb_z_csr_maxval(a) result(res) + import :: psb_z_csr_sparse_mat, psb_dpk_ + class(psb_z_csr_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + end function psb_z_csr_maxval + end interface + interface function psb_z_csr_csnmi(a) result(res) import :: psb_z_csr_sparse_mat, psb_dpk_ @@ -338,6 +352,46 @@ module psb_z_csr_mat_mod end function psb_z_csr_csnmi end interface + interface + function psb_z_csr_csnm1(a) result(res) + import :: psb_z_csr_sparse_mat, psb_dpk_ + class(psb_z_csr_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + end function psb_z_csr_csnm1 + end interface + + interface + subroutine psb_z_csr_rowsum(d,a) + import :: psb_z_csr_sparse_mat, psb_dpk_ + class(psb_z_csr_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(out) :: d(:) + end subroutine psb_z_csr_rowsum + end interface + + interface + subroutine psb_z_csr_arwsum(d,a) + import :: psb_z_csr_sparse_mat, psb_dpk_ + class(psb_z_csr_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + end subroutine psb_z_csr_arwsum + end interface + + interface + subroutine psb_z_csr_colsum(d,a) + import :: psb_z_csr_sparse_mat, psb_dpk_ + class(psb_z_csr_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(out) :: d(:) + end subroutine psb_z_csr_colsum + end interface + + interface + subroutine psb_z_csr_aclsum(d,a) + import :: psb_z_csr_sparse_mat, psb_dpk_ + class(psb_z_csr_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + end subroutine psb_z_csr_aclsum + end interface + interface subroutine psb_z_csr_get_diag(a,d,info) import :: psb_z_csr_sparse_mat, psb_dpk_ diff --git a/base/modules/psb_z_linmap_mod.f90 b/base/modules/psb_z_linmap_mod.f90 index 05fdb6c99..4d78b0a8e 100644 --- a/base/modules/psb_z_linmap_mod.f90 +++ b/base/modules/psb_z_linmap_mod.f90 @@ -35,7 +35,6 @@ ! Defines facilities for mapping between vectors belonging ! to different spaces. ! - module psb_z_linmap_mod use psb_const_mod @@ -53,6 +52,16 @@ module psb_z_linmap_mod integer, intent(out) :: info complex(psb_dpk_), optional :: work(:) end subroutine psb_z_map_X2Y + subroutine psb_z_map_X2Y_vect(alpha,x,beta,y,map,info,work) + use psb_z_vect_mod + use psb_linmap_type_mod + implicit none + type(psb_zlinmap_type), intent(in) :: map + complex(psb_dpk_), intent(in) :: alpha,beta + type(psb_z_vect_type), intent(inout) :: x,y + integer, intent(out) :: info + complex(psb_dpk_), optional :: work(:) + end subroutine psb_z_map_X2Y_vect end interface interface psb_map_Y2X @@ -66,6 +75,16 @@ module psb_z_linmap_mod integer, intent(out) :: info complex(psb_dpk_), optional :: work(:) end subroutine psb_z_map_Y2X + subroutine psb_z_map_Y2X_vect(alpha,x,beta,y,map,info,work) + use psb_z_vect_mod + use psb_linmap_type_mod + implicit none + type(psb_zlinmap_type), intent(in) :: map + complex(psb_dpk_), intent(in) :: alpha,beta + type(psb_z_vect_type), intent(inout) :: x,y + integer, intent(out) :: info + complex(psb_dpk_), optional :: work(:) + end subroutine psb_z_map_Y2X_vect end interface diff --git a/base/modules/psb_z_mat_mod.f90 b/base/modules/psb_z_mat_mod.f90 index fe3b4a38b..1c2ce2632 100644 --- a/base/modules/psb_z_mat_mod.f90 +++ b/base/modules/psb_z_mat_mod.f90 @@ -129,20 +129,26 @@ module psb_z_mat_mod procedure, pass(a) :: z_transc_2mat => psb_z_transc_2mat generic, public :: transc => z_transc_1mat, z_transc_2mat - - ! Computational routines procedure, pass(a) :: get_diag => psb_z_get_diag + procedure, pass(a) :: maxval => psb_z_maxval procedure, pass(a) :: csnmi => psb_z_csnmi + procedure, pass(a) :: csnm1 => psb_z_csnm1 + procedure, pass(a) :: rowsum => psb_z_rowsum + procedure, pass(a) :: arwsum => psb_z_arwsum + procedure, pass(a) :: colsum => psb_z_colsum + procedure, pass(a) :: aclsum => psb_z_aclsum + procedure, pass(a) :: z_csmv_v => psb_z_csmv_vect procedure, pass(a) :: z_csmv => psb_z_csmv procedure, pass(a) :: z_csmm => psb_z_csmm - generic, public :: csmm => z_csmm, z_csmv + generic, public :: csmm => z_csmm, z_csmv, z_csmv_v procedure, pass(a) :: z_scals => psb_z_scals procedure, pass(a) :: z_scal => psb_z_scal generic, public :: scal => z_scals, z_scal + procedure, pass(a) :: z_cssv_v => psb_z_cssv_vect procedure, pass(a) :: z_cssv => psb_z_cssv procedure, pass(a) :: z_cssm => psb_z_cssm - generic, public :: cssm => z_cssm, z_cssv + generic, public :: cssm => z_cssm, z_cssv, z_cssv_v end type psb_zspmat_type @@ -602,6 +608,16 @@ module psb_z_mat_mod integer, intent(out) :: info character, optional, intent(in) :: trans end subroutine psb_z_csmv + subroutine psb_z_csmv_vect(alpha,a,x,beta,y,info,trans) + use psb_z_vect_mod, only : psb_z_vect_type + import :: psb_zspmat_type, psb_dpk_ + class(psb_zspmat_type), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta + type(psb_z_vect_type), intent(inout) :: x + type(psb_z_vect_type), intent(inout) :: y + integer, intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_csmv_vect end interface interface psb_cssm @@ -623,6 +639,25 @@ module psb_z_mat_mod character, optional, intent(in) :: trans, scale complex(psb_dpk_), intent(in), optional :: d(:) end subroutine psb_z_cssv + subroutine psb_z_cssv_vect(alpha,a,x,beta,y,info,trans,scale,d) + use psb_z_vect_mod, only : psb_z_vect_type + import :: psb_zspmat_type, psb_dpk_ + class(psb_zspmat_type), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta + type(psb_z_vect_type), intent(inout) :: x + type(psb_z_vect_type), intent(inout) :: y + integer, intent(out) :: info + character, optional, intent(in) :: trans, scale + type(psb_z_vect_type), optional, intent(inout) :: d + end subroutine psb_z_cssv_vect + end interface + + interface + function psb_z_maxval(a) result(res) + import :: psb_zspmat_type, psb_dpk_ + class(psb_zspmat_type), intent(in) :: a + real(psb_dpk_) :: res + end function psb_z_maxval end interface interface @@ -633,6 +668,51 @@ module psb_z_mat_mod end function psb_z_csnmi end interface + interface + function psb_z_csnm1(a) result(res) + import :: psb_zspmat_type, psb_dpk_ + class(psb_zspmat_type), intent(in) :: a + real(psb_dpk_) :: res + end function psb_z_csnm1 + end interface + + interface + subroutine psb_z_rowsum(d,a,info) + import :: psb_zspmat_type, psb_dpk_ + class(psb_zspmat_type), intent(in) :: a + complex(psb_dpk_), intent(out) :: d(:) + integer, intent(out) :: info + end subroutine psb_z_rowsum + end interface + + interface + subroutine psb_z_arwsum(d,a,info) + import :: psb_zspmat_type, psb_dpk_ + class(psb_zspmat_type), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + integer, intent(out) :: info + end subroutine psb_z_arwsum + end interface + + interface + subroutine psb_z_colsum(d,a,info) + import :: psb_zspmat_type, psb_dpk_ + class(psb_zspmat_type), intent(in) :: a + complex(psb_dpk_), intent(out) :: d(:) + integer, intent(out) :: info + end subroutine psb_z_colsum + end interface + + interface + subroutine psb_z_aclsum(d,a,info) + import :: psb_zspmat_type, psb_dpk_ + class(psb_zspmat_type), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + integer, intent(out) :: info + end subroutine psb_z_aclsum + end interface + + interface subroutine psb_z_get_diag(a,d,info) import :: psb_zspmat_type, psb_dpk_ @@ -658,8 +738,6 @@ module psb_z_mat_mod end interface - - contains diff --git a/base/modules/psb_z_psblas_mod.f90 b/base/modules/psb_z_psblas_mod.f90 index c8102c5a0..bcd21928f 100644 --- a/base/modules/psb_z_psblas_mod.f90 +++ b/base/modules/psb_z_psblas_mod.f90 @@ -32,6 +32,14 @@ module psb_z_psblas_mod interface psb_gedot + function psb_zdot_vect(x, y, desc_a,info) result(res) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + use psb_z_vect_mod, only : psb_z_vect_type + complex(psb_dpk_) :: res + type(psb_z_vect_type), intent(inout) :: x, y + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + end function psb_zdot_vect function psb_zdotv(x, y, desc_a,info) use psb_descriptor_type, only : psb_desc_type, psb_dpk_ complex(psb_dpk_) :: psb_zdotv @@ -68,6 +76,16 @@ module psb_z_psblas_mod end interface interface psb_geaxpby + subroutine psb_zaxpby_vect(alpha, x, beta, y,& + & desc_a, info) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + use psb_z_vect_mod, only : psb_z_vect_type + type(psb_z_vect_type), intent (inout) :: x + type(psb_z_vect_type), intent (inout) :: y + complex(psb_dpk_), intent (in) :: alpha, beta + type(psb_desc_type), intent (in) :: desc_a + integer, intent(out) :: info + end subroutine psb_zaxpby_vect subroutine psb_zaxpbyv(alpha, x, beta, y,& & desc_a, info) use psb_descriptor_type, only : psb_desc_type, psb_dpk_ @@ -105,6 +123,14 @@ module psb_z_psblas_mod type(psb_desc_type), intent (in) :: desc_a integer, intent(out) :: info end function psb_zamaxv + function psb_zamax_vect(x, desc_a, info) result(res) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + use psb_z_vect_mod, only : psb_z_vect_type + real(psb_dpk_) :: res + type(psb_z_vect_type), intent (inout) :: x + type(psb_desc_type), intent (in) :: desc_a + integer, intent(out) :: info + end function psb_zamax_vect end interface interface psb_geamaxs @@ -126,6 +152,14 @@ module psb_z_psblas_mod end interface interface psb_geasum + function psb_zasum_vect(x, desc_a, info) result(res) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + use psb_z_vect_mod, only : psb_z_vect_type + real(psb_dpk_) :: res + type(psb_z_vect_type), intent (inout) :: x + type(psb_desc_type), intent (in) :: desc_a + integer, intent(out) :: info + end function psb_zasum_vect function psb_zasum(x, desc_a, info, jx) use psb_descriptor_type, only : psb_desc_type, psb_dpk_ real(psb_dpk_) psb_zasum @@ -177,6 +211,14 @@ module psb_z_psblas_mod type(psb_desc_type), intent (in) :: desc_a integer, intent(out) :: info end function psb_znrm2v + function psb_znrm2_vect(x, desc_a, info) result(res) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + use psb_z_vect_mod, only : psb_z_vect_type + real(psb_dpk_) :: res + type(psb_z_vect_type), intent (inout) :: x + type(psb_desc_type), intent (in) :: desc_a + integer, intent(out) :: info + end function psb_znrm2_vect end interface interface psb_genrm2s @@ -197,10 +239,21 @@ module psb_z_psblas_mod real(psb_dpk_) :: psb_znrmi type(psb_zspmat_type), intent (in) :: a type(psb_desc_type), intent (in) :: desc_a - integer, intent(out) :: info + integer, intent(out) :: info end function psb_znrmi end interface + interface psb_spnrm1 + function psb_zspnrm1(a, desc_a,info) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + use psb_mat_mod, only : psb_zspmat_type + real(psb_dpk_) :: psb_zspnrm1 + type(psb_zspmat_type), intent (in) :: a + type(psb_desc_type), intent (in) :: desc_a + integer, intent(out) :: info + end function psb_zspnrm1 + end interface + interface psb_spmm subroutine psb_zspmm(alpha, a, x, beta, y, desc_a, info,& &trans, k, jx, jy,work,doswap) @@ -231,6 +284,21 @@ module psb_z_psblas_mod logical, optional, intent(in) :: doswap integer, intent(out) :: info end subroutine psb_zspmv + subroutine psb_zspmv_vect(alpha, a, x, beta, y,& + & desc_a, info, trans, work,doswap) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + use psb_z_vect_mod, only : psb_z_vect_type + use psb_mat_mod, only : psb_zspmat_type + type(psb_zspmat_type), intent(in) :: a + type(psb_z_vect_type), intent(inout) :: x + type(psb_z_vect_type), intent(inout) :: y + complex(psb_dpk_), intent(in) :: alpha, beta + type(psb_desc_type), intent(in) :: desc_a + character, optional, intent(in) :: trans + complex(psb_dpk_), optional, intent(inout),target :: work(:) + logical, optional, intent(in) :: doswap + integer, intent(out) :: info + end subroutine psb_zspmv_vect end interface interface psb_spsm @@ -267,6 +335,23 @@ module psb_z_psblas_mod complex(psb_dpk_), optional, intent(inout), target :: work(:) integer, intent(out) :: info end subroutine psb_zspsv + subroutine psb_zspsv_vect(alpha, t, x, beta, y,& + & desc_a, info, trans, scale, choice,& + & diag, work) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + use psb_z_vect_mod, only : psb_z_vect_type + use psb_mat_mod, only : psb_zspmat_type + type(psb_zspmat_type), intent(inout) :: t + type(psb_z_vect_type), intent(inout) :: x + type(psb_z_vect_type), intent(inout) :: y + complex(psb_dpk_), intent(in) :: alpha, beta + type(psb_desc_type), intent(in) :: desc_a + character, optional, intent(in) :: trans, scale + integer, optional, intent(in) :: choice + type(psb_z_vect_type), intent(inout), optional :: diag + complex(psb_dpk_), optional, intent(inout), target :: work(:) + integer, intent(out) :: info + end subroutine psb_zspsv_vect end interface end module psb_z_psblas_mod diff --git a/base/modules/psb_z_tools_mod.f90 b/base/modules/psb_z_tools_mod.f90 index 37ed0b48a..47973f0dd 100644 --- a/base/modules/psb_z_tools_mod.f90 +++ b/base/modules/psb_z_tools_mod.f90 @@ -47,6 +47,22 @@ Module psb_z_tools_mod integer, intent(out) :: info integer, optional, intent(in) :: n end subroutine psb_zallocv + subroutine psb_zalloc_vect(x, desc_a,info,n) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + use psb_z_vect_mod + type(psb_z_vect_type), intent(out) :: x + type(psb_desc_type), intent(in) :: desc_a + integer,intent(out) :: info + integer, optional, intent(in) :: n + end subroutine psb_zalloc_vect + subroutine psb_zalloc_vect_r2(x, desc_a,info,n,lb) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + use psb_z_vect_mod + type(psb_z_vect_type), allocatable, intent(out) :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer,intent(out) :: info + integer, optional, intent(in) :: n, lb + end subroutine psb_zalloc_vect_r2 end interface @@ -63,6 +79,22 @@ Module psb_z_tools_mod complex(psb_dpk_), allocatable, intent(inout) :: x(:) integer, intent(out) :: info end subroutine psb_zasbv + subroutine psb_zasb_vect(x, desc_a, info,mold) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + use psb_z_vect_mod + type(psb_desc_type), intent(in) :: desc_a + type(psb_z_vect_type), intent(inout) :: x + integer, intent(out) :: info + class(psb_z_base_vect_type), intent(in), optional :: mold + end subroutine psb_zasb_vect + subroutine psb_zasb_vect_r2(x, desc_a, info,mold) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + use psb_z_vect_mod + type(psb_desc_type), intent(in) :: desc_a + type(psb_z_vect_type), intent(inout) :: x(:) + integer, intent(out) :: info + class(psb_z_base_vect_type), intent(in), optional :: mold + end subroutine psb_zasb_vect_r2 end interface interface psb_sphalo @@ -93,6 +125,20 @@ Module psb_z_tools_mod type(psb_desc_type), intent(in) :: desc_a integer, intent(out) :: info end subroutine psb_zfreev + subroutine psb_zfree_vect(x, desc_a, info) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + use psb_z_vect_mod + type(psb_desc_type), intent(in) :: desc_a + type(psb_z_vect_type), intent(inout) :: x + integer, intent(out) :: info + end subroutine psb_zfree_vect + subroutine psb_zfree_vect_r2(x, desc_a, info) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + use psb_z_vect_mod + type(psb_desc_type), intent(in) :: desc_a + type(psb_z_vect_type), allocatable, intent(inout) :: x(:) + integer, intent(out) :: info + end subroutine psb_zfree_vect_r2 end interface @@ -117,10 +163,30 @@ Module psb_z_tools_mod integer, intent(out) :: info integer, optional, intent(in) :: dupl end subroutine psb_zinsvi + subroutine psb_zins_vect(m,irw,val,x,desc_a,info,dupl) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + use psb_z_vect_mod + integer, intent(in) :: m + type(psb_desc_type), intent(in) :: desc_a + type(psb_z_vect_type), intent(inout) :: x + integer, intent(in) :: irw(:) + complex(psb_dpk_), intent(in) :: val(:) + integer, intent(out) :: info + integer, optional, intent(in) :: dupl + end subroutine psb_zins_vect + subroutine psb_zins_vect_r2(m,irw,val,x,desc_a,info,dupl) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + use psb_z_vect_mod + integer, intent(in) :: m + type(psb_desc_type), intent(in) :: desc_a + type(psb_z_vect_type), intent(inout) :: x(:) + integer, intent(in) :: irw(:) + complex(psb_dpk_), intent(in) :: val(:,:) + integer, intent(out) :: info + integer, optional, intent(in) :: dupl + end subroutine psb_zins_vect_r2 end interface - - interface psb_cdbldext Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info,extype) use psb_descriptor_type, only : psb_desc_type, psb_dpk_ @@ -204,91 +270,4 @@ Module psb_z_tools_mod end subroutine psb_zsprn end interface - -!!$ interface psb_linmap_init -!!$ module procedure psb_zlinmap_init -!!$ end interface -!!$ -!!$ interface psb_linmap_ins -!!$ module procedure psb_zlinmap_ins -!!$ end interface -!!$ -!!$ interface psb_linmap_asb -!!$ module procedure psb_zlinmap_asb -!!$ end interface -!!$ -!!$contains -!!$ -!!$ -!!$ subroutine psb_zlinmap_init(a_map,cd_xt,descin,descout) -!!$ use psb_base_tools_mod -!!$ use psb_z_mat_mod -!!$ use psb_descriptor_type -!!$ use psb_serial_mod -!!$ use psb_penv_mod -!!$ use psb_error_mod -!!$ implicit none -!!$ type(psb_zspmat_type), intent(out) :: a_map -!!$ type(psb_desc_type), intent(out) :: cd_xt -!!$ type(psb_desc_type), intent(in) :: descin, descout -!!$ -!!$ integer :: nrow_in, nrow_out, ncol_in, info, ictxt -!!$ -!!$ ictxt = psb_cd_get_context(descin) -!!$ -!!$ call psb_cdcpy(descin,cd_xt,info) -!!$ if (info == psb_success_) call psb_cd_reinit(cd_xt,info) -!!$ if (info /= psb_success_) then -!!$ write(psb_err_unit,*) 'Error on reinitialising the extension map' -!!$ call psb_error(ictxt) -!!$ call psb_abort(ictxt) -!!$ stop -!!$ end if -!!$ -!!$ nrow_in = psb_cd_get_local_rows(cd_xt) -!!$ ncol_in = psb_cd_get_local_cols(cd_xt) -!!$ nrow_out = psb_cd_get_local_rows(descout) -!!$ -!!$ call a_map%csall(nrow_out,ncol_in,info) -!!$ -!!$ end subroutine psb_zlinmap_init -!!$ -!!$ subroutine psb_zlinmap_ins(nz,ir,ic,val,a_map,cd_xt,descin,descout) -!!$ use psb_base_tools_mod -!!$ use psb_z_mat_mod -!!$ use psb_descriptor_type -!!$ implicit none -!!$ integer, intent(in) :: nz -!!$ integer, intent(in) :: ir(:),ic(:) -!!$ complex(psb_dpk_), intent(in) :: val(:) -!!$ type(psb_zspmat_type), intent(inout) :: a_map -!!$ type(psb_desc_type), intent(inout) :: cd_xt -!!$ type(psb_desc_type), intent(in) :: descin, descout -!!$ integer :: info -!!$ -!!$ call psb_spins(nz,ir,ic,val,a_map,descout,cd_xt,info) -!!$ -!!$ end subroutine psb_zlinmap_ins -!!$ -!!$ subroutine psb_zlinmap_asb(a_map,cd_xt,descin,descout,afmt) -!!$ use psb_base_tools_mod -!!$ use psb_z_mat_mod -!!$ use psb_descriptor_type -!!$ use psb_serial_mod -!!$ implicit none -!!$ type(psb_zspmat_type), intent(inout) :: a_map -!!$ type(psb_desc_type), intent(inout) :: cd_xt -!!$ type(psb_desc_type), intent(in) :: descin, descout -!!$ character(len=*), optional, intent(in) :: afmt -!!$ -!!$ integer :: nrow_in, nrow_out, ncol_in, info, ictxt -!!$ -!!$ ictxt = psb_cd_get_context(descin) -!!$ -!!$ call psb_cdasb(cd_xt,info) -!!$ call a_map%set_ncols(psb_cd_get_local_cols(cd_xt)) -!!$ call a_map%cscnv(info,type=afmt) -!!$ -!!$ end subroutine psb_zlinmap_asb - end module psb_z_tools_mod diff --git a/base/modules/psb_z_vect_mod.f90 b/base/modules/psb_z_vect_mod.f90 new file mode 100644 index 000000000..979559f44 --- /dev/null +++ b/base/modules/psb_z_vect_mod.f90 @@ -0,0 +1,505 @@ +module psb_z_vect_mod + + use psb_z_base_vect_mod + + type psb_z_vect_type + class(psb_z_base_vect_type), allocatable :: v + contains + procedure, pass(x) :: get_nrows => z_vect_get_nrows + procedure, pass(x) :: dot_v => z_vect_dot_v + procedure, pass(x) :: dot_a => z_vect_dot_a + generic, public :: dot => dot_v, dot_a + procedure, pass(y) :: axpby_v => z_vect_axpby_v + procedure, pass(y) :: axpby_a => z_vect_axpby_a + generic, public :: axpby => axpby_v, axpby_a + procedure, pass(y) :: mlt_v => z_vect_mlt_v + procedure, pass(y) :: mlt_a => z_vect_mlt_a + procedure, pass(z) :: mlt_a_2 => z_vect_mlt_a_2 + procedure, pass(z) :: mlt_v_2 => z_vect_mlt_v_2 + procedure, pass(z) :: mlt_va => z_vect_mlt_va + procedure, pass(z) :: mlt_av => z_vect_mlt_av + generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,& + & mlt_v_2, mlt_av, mlt_va + procedure, pass(x) :: scal => z_vect_scal + procedure, pass(x) :: nrm2 => z_vect_nrm2 + procedure, pass(x) :: amax => z_vect_amax + procedure, pass(x) :: asum => z_vect_asum + procedure, pass(x) :: all => z_vect_all + procedure, pass(x) :: zero => z_vect_zero + procedure, pass(x) :: asb => z_vect_asb + procedure, pass(x) :: sync => z_vect_sync + procedure, pass(x) :: gthab => z_vect_gthab + procedure, pass(x) :: gthzv => z_vect_gthzv + generic, public :: gth => gthab, gthzv + procedure, pass(y) :: sctb => z_vect_sctb + generic, public :: sct => sctb + procedure, pass(x) :: free => z_vect_free + procedure, pass(x) :: ins => z_vect_ins + procedure, pass(x) :: bld_x => z_vect_bld_x + procedure, pass(x) :: bld_n => z_vect_bld_n + generic, public :: bld => bld_x, bld_n + procedure, pass(x) :: getCopy => z_vect_getCopy + procedure, pass(x) :: cpy_vect => z_vect_cpy_vect + generic, public :: assignment(=) => cpy_vect + procedure, pass(x) :: cnv => z_vect_cnv + procedure, pass(x) :: set_scal => z_vect_set_scal + procedure, pass(x) :: set_vect => z_vect_set_vect + generic, public :: set => set_vect, set_scal + end type psb_z_vect_type + + public :: psb_z_vect + private :: constructor, size_const + interface psb_z_vect + module procedure constructor, size_const + end interface psb_z_vect + +contains + + subroutine z_vect_bld_x(x,invect,mold) + complex(psb_dpk_), intent(in) :: invect(:) + class(psb_z_vect_type), intent(out) :: x + class(psb_z_base_vect_type), intent(in), optional :: mold + integer :: info + + if (present(mold)) then + allocate(x%v,stat=info,mold=mold) + else + allocate(psb_z_base_vect_type :: x%v,stat=info) + endif + + if (info == psb_success_) call x%v%bld(invect) + + end subroutine z_vect_bld_x + + + subroutine z_vect_bld_n(x,n,mold) + integer, intent(in) :: n + class(psb_z_vect_type), intent(out) :: x + class(psb_z_base_vect_type), intent(in), optional :: mold + integer :: info + + if (present(mold)) then + allocate(x%v,stat=info,mold=mold) + else + allocate(psb_z_base_vect_type :: x%v,stat=info) + endif + if (info == psb_success_) call x%v%bld(n) + + end subroutine z_vect_bld_n + + function z_vect_getCopy(x) result(res) + class(psb_z_vect_type), intent(in) :: x + complex(psb_dpk_), allocatable :: res(:) + integer :: info + + if (allocated(x%v)) res = x%v%getCopy() + + end function z_vect_getCopy + + subroutine z_vect_cpy_vect(res,x) + complex(psb_dpk_), allocatable, intent(out) :: res(:) + class(psb_z_vect_type), intent(in) :: x + integer :: info + + if (allocated(x%v)) res = x%v + + end subroutine z_vect_cpy_vect + + subroutine z_vect_set_scal(x,val) + class(psb_z_vect_type), intent(inout) :: x + complex(psb_dpk_), intent(in) :: val + + integer :: info + if (allocated(x%v)) call x%v%set(val) + + end subroutine z_vect_set_scal + + subroutine z_vect_set_vect(x,val) + class(psb_z_vect_type), intent(inout) :: x + complex(psb_dpk_), intent(in) :: val(:) + + integer :: info + if (allocated(x%v)) call x%v%set(val) + + end subroutine z_vect_set_vect + + + function constructor(x) result(this) + complex(psb_dpk_) :: x(:) + type(psb_z_vect_type) :: this + integer :: info + + allocate(psb_z_base_vect_type :: this%v, stat=info) + + if (info == 0) call this%v%bld(x) + + call this%asb(size(x),info) + + end function constructor + + + function size_const(n) result(this) + integer, intent(in) :: n + type(psb_z_vect_type) :: this + integer :: info + + allocate(psb_z_base_vect_type :: this%v, stat=info) + call this%asb(n,info) + + end function size_const + + + function z_vect_get_nrows(x) result(res) + implicit none + class(psb_z_vect_type), intent(in) :: x + integer :: res + res = -1 + if (allocated(x%v)) res = x%v%get_nrows() + end function z_vect_get_nrows + + function z_vect_dot_v(n,x,y) result(res) + implicit none + class(psb_z_vect_type), intent(inout) :: x, y + integer, intent(in) :: n + complex(psb_dpk_) :: res + + res = czero + if (allocated(x%v).and.allocated(y%v)) & + & res = x%v%dot(n,y%v) + + end function z_vect_dot_v + + function z_vect_dot_a(n,x,y) result(res) + implicit none + class(psb_z_vect_type), intent(inout) :: x + complex(psb_dpk_), intent(in) :: y(:) + integer, intent(in) :: n + complex(psb_dpk_) :: res + + res = czero + if (allocated(x%v)) & + & res = x%v%dot(n,y) + + end function z_vect_dot_a + + subroutine z_vect_axpby_v(m,alpha, x, beta, y, info) + use psi_serial_mod + implicit none + integer, intent(in) :: m + class(psb_z_vect_type), intent(inout) :: x + class(psb_z_vect_type), intent(inout) :: y + complex(psb_dpk_), intent (in) :: alpha, beta + integer, intent(out) :: info + + if (allocated(x%v).and.allocated(y%v)) then + call y%v%axpby(m,alpha,x%v,beta,info) + else + info = psb_err_invalid_vect_state_ + end if + + end subroutine z_vect_axpby_v + + subroutine z_vect_axpby_a(m,alpha, x, beta, y, info) + use psi_serial_mod + implicit none + integer, intent(in) :: m + complex(psb_dpk_), intent(in) :: x(:) + class(psb_z_vect_type), intent(inout) :: y + complex(psb_dpk_), intent (in) :: alpha, beta + integer, intent(out) :: info + + if (allocated(y%v)) & + & call y%v%axpby(m,alpha,x,beta,info) + + end subroutine z_vect_axpby_a + + + subroutine z_vect_mlt_v(x, y, info) + use psi_serial_mod + implicit none + class(psb_z_vect_type), intent(inout) :: x + class(psb_z_vect_type), intent(inout) :: y + integer, intent(out) :: info + integer :: i, n + + info = 0 + if (allocated(x%v).and.allocated(y%v)) & + & call y%v%mlt(x%v,info) + + end subroutine z_vect_mlt_v + + subroutine z_vect_mlt_a(x, y, info) + use psi_serial_mod + implicit none + complex(psb_dpk_), intent(in) :: x(:) + class(psb_z_vect_type), intent(inout) :: y + integer, intent(out) :: info + integer :: i, n + + + info = 0 + if (allocated(y%v)) & + & call y%v%mlt(x,info) + + end subroutine z_vect_mlt_a + + + subroutine z_vect_mlt_a_2(alpha,x,y,beta,z,info) + use psi_serial_mod + implicit none + complex(psb_dpk_), intent(in) :: alpha,beta + complex(psb_dpk_), intent(in) :: y(:) + complex(psb_dpk_), intent(in) :: x(:) + class(psb_z_vect_type), intent(inout) :: z + integer, intent(out) :: info + integer :: i, n + + info = 0 + if (allocated(z%v)) & + & call z%v%mlt(alpha,x,y,beta,info) + + end subroutine z_vect_mlt_a_2 + + subroutine z_vect_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy) + use psi_serial_mod + implicit none + complex(psb_dpk_), intent(in) :: alpha,beta + class(psb_z_vect_type), intent(inout) :: x + class(psb_z_vect_type), intent(inout) :: y + class(psb_z_vect_type), intent(inout) :: z + integer, intent(out) :: info + character(len=1), intent(in), optional :: conjgx, conjgy + + integer :: i, n + + info = 0 + if (allocated(x%v).and.allocated(y%v).and.& + & allocated(z%v)) & + & call z%v%mlt(alpha,x%v,y%v,beta,info,conjgx,conjgy) + + end subroutine z_vect_mlt_v_2 + + subroutine z_vect_mlt_av(alpha,x,y,beta,z,info) + use psi_serial_mod + implicit none + complex(psb_dpk_), intent(in) :: alpha,beta + complex(psb_dpk_), intent(in) :: x(:) + class(psb_z_vect_type), intent(inout) :: y + class(psb_z_vect_type), intent(inout) :: z + integer, intent(out) :: info + integer :: i, n + + info = 0 + if (allocated(z%v).and.allocated(y%v)) & + & call z%v%mlt(alpha,x,y%v,beta,info) + + end subroutine z_vect_mlt_av + + subroutine z_vect_mlt_va(alpha,x,y,beta,z,info) + use psi_serial_mod + implicit none + complex(psb_dpk_), intent(in) :: alpha,beta + complex(psb_dpk_), intent(in) :: y(:) + class(psb_z_vect_type), intent(inout) :: x + class(psb_z_vect_type), intent(inout) :: z + integer, intent(out) :: info + integer :: i, n + + info = 0 + + if (allocated(z%v).and.allocated(x%v)) & + & call z%v%mlt(alpha,x%v,y,beta,info) + + end subroutine z_vect_mlt_va + + subroutine z_vect_scal(alpha, x) + use psi_serial_mod + implicit none + class(psb_z_vect_type), intent(inout) :: x + complex(psb_dpk_), intent (in) :: alpha + + if (allocated(x%v)) call x%v%scal(alpha) + + end subroutine z_vect_scal + + + function z_vect_nrm2(n,x) result(res) + implicit none + class(psb_z_vect_type), intent(inout) :: x + integer, intent(in) :: n + real(psb_dpk_) :: res + + if (allocated(x%v)) then + res = x%v%nrm2(n) + else + res = dzero + end if + + end function z_vect_nrm2 + + function z_vect_amax(n,x) result(res) + implicit none + class(psb_z_vect_type), intent(inout) :: x + integer, intent(in) :: n + real(psb_dpk_) :: res + + if (allocated(x%v)) then + res = x%v%amax(n) + else + res = dzero + end if + + end function z_vect_amax + + function z_vect_asum(n,x) result(res) + implicit none + class(psb_z_vect_type), intent(inout) :: x + integer, intent(in) :: n + real(psb_dpk_) :: res + + if (allocated(x%v)) then + res = x%v%asum(n) + else + res = dzero + end if + + end function z_vect_asum + + subroutine z_vect_all(n, x, info, mold) + + implicit none + integer, intent(in) :: n + class(psb_z_vect_type), intent(out) :: x + class(psb_z_base_vect_type), intent(in), optional :: mold + integer, intent(out) :: info + + if (present(mold)) then + allocate(x%v,stat=info,mold=mold) + else + allocate(psb_z_base_vect_type :: x%v,stat=info) + endif + if (info == 0) then + call x%v%all(n,info) + else + info = psb_err_alloc_dealloc_ + end if + + end subroutine z_vect_all + + subroutine z_vect_zero(x) + use psi_serial_mod + implicit none + class(psb_z_vect_type), intent(inout) :: x + + if (allocated(x%v)) call x%v%zero() + + end subroutine z_vect_zero + + subroutine z_vect_asb(n, x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + integer, intent(in) :: n + class(psb_z_vect_type), intent(inout) :: x + integer, intent(out) :: info + + if (allocated(x%v)) & + & call x%v%asb(n,info) + + end subroutine z_vect_asb + + subroutine z_vect_sync(x) + implicit none + class(psb_z_vect_type), intent(inout) :: x + + if (allocated(x%v)) & + & call x%v%sync() + + end subroutine z_vect_sync + + subroutine z_vect_gthab(n,idx,alpha,x,beta,y) + use psi_serial_mod + integer :: n, idx(:) + complex(psb_dpk_) :: alpha, beta, y(:) + class(psb_z_vect_type) :: x + + if (allocated(x%v)) & + & call x%v%gth(n,idx,alpha,beta,y) + + end subroutine z_vect_gthab + + subroutine z_vect_gthzv(n,idx,x,y) + use psi_serial_mod + integer :: n, idx(:) + complex(psb_dpk_) :: y(:) + class(psb_z_vect_type) :: x + + if (allocated(x%v)) & + & call x%v%gth(n,idx,y) + + end subroutine z_vect_gthzv + + subroutine z_vect_sctb(n,idx,x,beta,y) + use psi_serial_mod + integer :: n, idx(:) + complex(psb_dpk_) :: beta, x(:) + class(psb_z_vect_type) :: y + + if (allocated(y%v)) & + & call y%v%sct(n,idx,x,beta) + + end subroutine z_vect_sctb + + subroutine z_vect_free(x, info) + use psi_serial_mod + use psb_realloc_mod + implicit none + class(psb_z_vect_type), intent(inout) :: x + integer, intent(out) :: info + + info = 0 + if (allocated(x%v)) then + call x%v%free(info) + if (info == 0) deallocate(x%v,stat=info) + end if + + end subroutine z_vect_free + + subroutine z_vect_ins(n,irl,val,dupl,x,info) + use psi_serial_mod + implicit none + class(psb_z_vect_type), intent(inout) :: x + integer, intent(in) :: n, dupl + integer, intent(in) :: irl(:) + complex(psb_dpk_), intent(in) :: val(:) + integer, intent(out) :: info + + integer :: i + + info = 0 + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + return + end if + + call x%v%ins(n,irl,val,dupl,info) + + end subroutine z_vect_ins + + + subroutine z_vect_cnv(x,mold) + class(psb_z_vect_type), intent(inout) :: x + class(psb_z_base_vect_type), intent(in) :: mold + class(psb_z_base_vect_type), allocatable :: tmp + complex(psb_dpk_), allocatable :: invect(:) + integer :: info + + allocate(tmp,stat=info,mold=mold) + call x%v%sync() + if (info == psb_success_) call tmp%bld(x%v%v) + call x%v%free(info) + call move_alloc(tmp,x%v) + + end subroutine z_vect_cnv + +end module psb_z_vect_mod diff --git a/base/modules/psi_c_mod.f90 b/base/modules/psi_c_mod.f90 new file mode 100644 index 000000000..9deee7975 --- /dev/null +++ b/base/modules/psi_c_mod.f90 @@ -0,0 +1,242 @@ +!!$ +!!$ Parallel Sparse BLAS version 3.0 +!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +module psi_c_mod + + interface psi_swapdata + subroutine psi_cswapdatam(flag,n,beta,y,desc_a,work,info,data) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + integer, intent(in) :: flag, n + integer, intent(out) :: info + complex(psb_spk_) :: y(:,:), beta + complex(psb_spk_),target :: work(:) + type(psb_desc_type), target :: desc_a + integer, optional :: data + end subroutine psi_cswapdatam + subroutine psi_cswapdatav(flag,beta,y,desc_a,work,info,data) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + integer, intent(in) :: flag + integer, intent(out) :: info + complex(psb_spk_) :: y(:), beta + complex(psb_spk_),target :: work(:) + type(psb_desc_type), target :: desc_a + integer, optional :: data + end subroutine psi_cswapdatav + subroutine psi_cswapdata_vect(flag,beta,y,desc_a,work,info,data) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + use psb_c_base_vect_mod + integer, intent(in) :: flag + integer, intent(out) :: info + class(psb_c_base_vect_type) :: y + complex(psb_spk_) :: beta + complex(psb_spk_),target :: work(:) + type(psb_desc_type), target :: desc_a + integer, optional :: data + end subroutine psi_cswapdata_vect + subroutine psi_cswapidxm(ictxt,icomm,flag,n,beta,y,idx,& + & totxch,totsnd,totrcv,work,info) + use psb_const_mod + integer, intent(in) :: ictxt,icomm,flag, n + integer, intent(out) :: info + complex(psb_spk_) :: y(:,:), beta + complex(psb_spk_),target :: work(:) + integer, intent(in) :: idx(:),totxch,totsnd,totrcv + end subroutine psi_cswapidxm + subroutine psi_cswapidxv(ictxt,icomm,flag,beta,y,idx,& + & totxch,totsnd,totrcv,work,info) + use psb_const_mod + integer, intent(in) :: ictxt,icomm,flag + integer, intent(out) :: info + complex(psb_spk_) :: y(:), beta + complex(psb_spk_),target :: work(:) + integer, intent(in) :: idx(:),totxch,totsnd,totrcv + end subroutine psi_cswapidxv + subroutine psi_cswapidx_vect(ictxt,icomm,flag,beta,y,idx,& + & totxch,totsnd,totrcv,work,info) + use psb_const_mod + use psb_c_base_vect_mod + integer, intent(in) :: ictxt,icomm,flag + integer, intent(out) :: info + class(psb_c_base_vect_type) :: y + complex(psb_spk_) :: beta + complex(psb_spk_),target :: work(:) + integer, intent(in) :: idx(:),totxch,totsnd,totrcv + end subroutine psi_cswapidx_vect + end interface + + + interface psi_swaptran + subroutine psi_cswaptranm(flag,n,beta,y,desc_a,work,info,data) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + integer, intent(in) :: flag, n + integer, intent(out) :: info + complex(psb_spk_) :: y(:,:), beta + complex(psb_spk_),target :: work(:) + type(psb_desc_type), target :: desc_a + integer, optional :: data + end subroutine psi_cswaptranm + subroutine psi_cswaptranv(flag,beta,y,desc_a,work,info,data) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + integer, intent(in) :: flag + integer, intent(out) :: info + complex(psb_spk_) :: y(:), beta + complex(psb_spk_),target :: work(:) + type(psb_desc_type), target :: desc_a + integer, optional :: data + end subroutine psi_cswaptranv + subroutine psi_cswaptran_vect(flag,beta,y,desc_a,work,info,data) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + use psb_c_base_vect_mod + integer, intent(in) :: flag + integer, intent(out) :: info + class(psb_c_base_vect_type) :: y + complex(psb_spk_) :: beta + complex(psb_spk_),target :: work(:) + type(psb_desc_type), target :: desc_a + integer, optional :: data + end subroutine psi_cswaptran_vect + subroutine psi_ctranidxm(ictxt,icomm,flag,n,beta,y,idx,& + & totxch,totsnd,totrcv,work,info) + use psb_const_mod + integer, intent(in) :: ictxt,icomm,flag, n + integer, intent(out) :: info + complex(psb_spk_) :: y(:,:), beta + complex(psb_spk_),target :: work(:) + integer, intent(in) :: idx(:),totxch,totsnd,totrcv + end subroutine psi_ctranidxm + subroutine psi_ctranidxv(ictxt,icomm,flag,beta,y,idx,& + & totxch,totsnd,totrcv,work,info) + use psb_const_mod + integer, intent(in) :: ictxt,icomm,flag + integer, intent(out) :: info + complex(psb_spk_) :: y(:), beta + complex(psb_spk_),target :: work(:) + integer, intent(in) :: idx(:),totxch,totsnd,totrcv + end subroutine psi_ctranidxv + subroutine psi_ctranidx_vect(ictxt,icomm,flag,beta,y,idx,& + & totxch,totsnd,totrcv,work,info) + use psb_const_mod + use psb_c_base_vect_mod + integer, intent(in) :: ictxt,icomm,flag + integer, intent(out) :: info + class(psb_c_base_vect_type) :: y + complex(psb_spk_) :: beta + complex(psb_spk_),target :: work(:) + integer, intent(in) :: idx(:),totxch,totsnd,totrcv + end subroutine psi_ctranidx_vect + end interface + + interface psi_ovrl_upd + subroutine psi_covrl_updr1(x,desc_a,update,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + complex(psb_spk_), intent(inout), target :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(in) :: update + integer, intent(out) :: info + end subroutine psi_covrl_updr1 + subroutine psi_covrl_updr2(x,desc_a,update,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + complex(psb_spk_), intent(inout), target :: x(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(in) :: update + integer, intent(out) :: info + end subroutine psi_covrl_updr2 + subroutine psi_covrl_upd_vect(x,desc_a,update,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + use psb_c_base_vect_mod + class(psb_c_base_vect_type) :: x + type(psb_desc_type), intent(in) :: desc_a + integer, intent(in) :: update + integer, intent(out) :: info + end subroutine psi_covrl_upd_vect + end interface + + interface psi_ovrl_save + subroutine psi_covrl_saver1(x,xs,desc_a,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + complex(psb_spk_), intent(inout) :: x(:) + complex(psb_spk_), allocatable :: xs(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + end subroutine psi_covrl_saver1 + subroutine psi_covrl_saver2(x,xs,desc_a,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + complex(psb_spk_), intent(inout) :: x(:,:) + complex(psb_spk_), allocatable :: xs(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + end subroutine psi_covrl_saver2 + subroutine psi_covrl_save_vect(x,xs,desc_a,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + use psb_c_base_vect_mod + class(psb_c_base_vect_type) :: x + complex(psb_spk_), allocatable :: xs(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + end subroutine psi_covrl_save_vect + end interface + + interface psi_ovrl_restore + subroutine psi_covrl_restrr1(x,xs,desc_a,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + complex(psb_spk_), intent(inout) :: x(:) + complex(psb_spk_) :: xs(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + end subroutine psi_covrl_restrr1 + subroutine psi_covrl_restrr2(x,xs,desc_a,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + complex(psb_spk_), intent(inout) :: x(:,:) + complex(psb_spk_) :: xs(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + end subroutine psi_covrl_restrr2 + subroutine psi_covrl_restr_vect(x,xs,desc_a,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + use psb_c_base_vect_mod + class(psb_c_base_vect_type) :: x + complex(psb_spk_) :: xs(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + end subroutine psi_covrl_restr_vect + end interface + +end module psi_c_mod + diff --git a/base/modules/psi_d_mod.f90 b/base/modules/psi_d_mod.f90 new file mode 100644 index 000000000..f0eec1e47 --- /dev/null +++ b/base/modules/psi_d_mod.f90 @@ -0,0 +1,242 @@ +!!$ +!!$ Parallel Sparse BLAS version 3.0 +!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +module psi_d_mod + + interface psi_swapdata + subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + integer, intent(in) :: flag, n + integer, intent(out) :: info + real(psb_dpk_) :: y(:,:), beta + real(psb_dpk_),target :: work(:) + type(psb_desc_type), target :: desc_a + integer, optional :: data + end subroutine psi_dswapdatam + subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + integer, intent(in) :: flag + integer, intent(out) :: info + real(psb_dpk_) :: y(:), beta + real(psb_dpk_),target :: work(:) + type(psb_desc_type), target :: desc_a + integer, optional :: data + end subroutine psi_dswapdatav + subroutine psi_dswapdata_vect(flag,beta,y,desc_a,work,info,data) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + use psb_d_base_vect_mod + integer, intent(in) :: flag + integer, intent(out) :: info + class(psb_d_base_vect_type) :: y + real(psb_dpk_) :: beta + real(psb_dpk_),target :: work(:) + type(psb_desc_type), target :: desc_a + integer, optional :: data + end subroutine psi_dswapdata_vect + subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx,& + & totxch,totsnd,totrcv,work,info) + use psb_const_mod + integer, intent(in) :: ictxt,icomm,flag, n + integer, intent(out) :: info + real(psb_dpk_) :: y(:,:), beta + real(psb_dpk_),target :: work(:) + integer, intent(in) :: idx(:),totxch,totsnd,totrcv + end subroutine psi_dswapidxm + subroutine psi_dswapidxv(ictxt,icomm,flag,beta,y,idx,& + & totxch,totsnd,totrcv,work,info) + use psb_const_mod + integer, intent(in) :: ictxt,icomm,flag + integer, intent(out) :: info + real(psb_dpk_) :: y(:), beta + real(psb_dpk_),target :: work(:) + integer, intent(in) :: idx(:),totxch,totsnd,totrcv + end subroutine psi_dswapidxv + subroutine psi_dswapidx_vect(ictxt,icomm,flag,beta,y,idx,& + & totxch,totsnd,totrcv,work,info) + use psb_const_mod + use psb_d_base_vect_mod + integer, intent(in) :: ictxt,icomm,flag + integer, intent(out) :: info + class(psb_d_base_vect_type) :: y + real(psb_dpk_) :: beta + real(psb_dpk_),target :: work(:) + integer, intent(in) :: idx(:),totxch,totsnd,totrcv + end subroutine psi_dswapidx_vect + end interface + + + interface psi_swaptran + subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + integer, intent(in) :: flag, n + integer, intent(out) :: info + real(psb_dpk_) :: y(:,:), beta + real(psb_dpk_),target :: work(:) + type(psb_desc_type), target :: desc_a + integer, optional :: data + end subroutine psi_dswaptranm + subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + integer, intent(in) :: flag + integer, intent(out) :: info + real(psb_dpk_) :: y(:), beta + real(psb_dpk_),target :: work(:) + type(psb_desc_type), target :: desc_a + integer, optional :: data + end subroutine psi_dswaptranv + subroutine psi_dswaptran_vect(flag,beta,y,desc_a,work,info,data) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + use psb_d_base_vect_mod + integer, intent(in) :: flag + integer, intent(out) :: info + class(psb_d_base_vect_type) :: y + real(psb_dpk_) :: beta + real(psb_dpk_),target :: work(:) + type(psb_desc_type), target :: desc_a + integer, optional :: data + end subroutine psi_dswaptran_vect + subroutine psi_dtranidxm(ictxt,icomm,flag,n,beta,y,idx,& + & totxch,totsnd,totrcv,work,info) + use psb_const_mod + integer, intent(in) :: ictxt,icomm,flag, n + integer, intent(out) :: info + real(psb_dpk_) :: y(:,:), beta + real(psb_dpk_),target :: work(:) + integer, intent(in) :: idx(:),totxch,totsnd,totrcv + end subroutine psi_dtranidxm + subroutine psi_dtranidxv(ictxt,icomm,flag,beta,y,idx,& + & totxch,totsnd,totrcv,work,info) + use psb_const_mod + integer, intent(in) :: ictxt,icomm,flag + integer, intent(out) :: info + real(psb_dpk_) :: y(:), beta + real(psb_dpk_),target :: work(:) + integer, intent(in) :: idx(:),totxch,totsnd,totrcv + end subroutine psi_dtranidxv + subroutine psi_dtranidx_vect(ictxt,icomm,flag,beta,y,idx,& + & totxch,totsnd,totrcv,work,info) + use psb_const_mod + use psb_d_base_vect_mod + integer, intent(in) :: ictxt,icomm,flag + integer, intent(out) :: info + class(psb_d_base_vect_type) :: y + real(psb_dpk_) :: beta + real(psb_dpk_),target :: work(:) + integer, intent(in) :: idx(:),totxch,totsnd,totrcv + end subroutine psi_dtranidx_vect + end interface + + interface psi_ovrl_upd + subroutine psi_dovrl_updr1(x,desc_a,update,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + real(psb_dpk_), intent(inout), target :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(in) :: update + integer, intent(out) :: info + end subroutine psi_dovrl_updr1 + subroutine psi_dovrl_updr2(x,desc_a,update,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + real(psb_dpk_), intent(inout), target :: x(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(in) :: update + integer, intent(out) :: info + end subroutine psi_dovrl_updr2 + subroutine psi_dovrl_upd_vect(x,desc_a,update,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + use psb_d_base_vect_mod + class(psb_d_base_vect_type) :: x + type(psb_desc_type), intent(in) :: desc_a + integer, intent(in) :: update + integer, intent(out) :: info + end subroutine psi_dovrl_upd_vect + end interface + + interface psi_ovrl_save + subroutine psi_dovrl_saver1(x,xs,desc_a,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + real(psb_dpk_), intent(inout) :: x(:) + real(psb_dpk_), allocatable :: xs(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + end subroutine psi_dovrl_saver1 + subroutine psi_dovrl_saver2(x,xs,desc_a,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + real(psb_dpk_), intent(inout) :: x(:,:) + real(psb_dpk_), allocatable :: xs(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + end subroutine psi_dovrl_saver2 + subroutine psi_dovrl_save_vect(x,xs,desc_a,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + use psb_d_base_vect_mod + class(psb_d_base_vect_type) :: x + real(psb_dpk_), allocatable :: xs(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + end subroutine psi_dovrl_save_vect + end interface + + interface psi_ovrl_restore + subroutine psi_dovrl_restrr1(x,xs,desc_a,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + real(psb_dpk_), intent(inout) :: x(:) + real(psb_dpk_) :: xs(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + end subroutine psi_dovrl_restrr1 + subroutine psi_dovrl_restrr2(x,xs,desc_a,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + real(psb_dpk_), intent(inout) :: x(:,:) + real(psb_dpk_) :: xs(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + end subroutine psi_dovrl_restrr2 + subroutine psi_dovrl_restr_vect(x,xs,desc_a,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + use psb_d_base_vect_mod + class(psb_d_base_vect_type) :: x + real(psb_dpk_) :: xs(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + end subroutine psi_dovrl_restr_vect + end interface + +end module psi_d_mod + diff --git a/base/modules/psi_i_mod.f90 b/base/modules/psi_i_mod.f90 new file mode 100644 index 000000000..fa479f0db --- /dev/null +++ b/base/modules/psi_i_mod.f90 @@ -0,0 +1,401 @@ +!!$ +!!$ Parallel Sparse BLAS version 3.0 +!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +module psi_i_mod + + interface + subroutine psi_compute_size(desc_data,& + & index_in, dl_lda, info) + integer :: info, dl_lda + integer :: desc_data(:), index_in(:) + end subroutine psi_compute_size + end interface + + interface + subroutine psi_crea_bnd_elem(bndel,desc_a,info) + use psb_descriptor_type, only : psb_desc_type + integer, allocatable :: bndel(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + end subroutine psi_crea_bnd_elem + end interface + + interface + subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,nxch,nsnd,nrcv,info) + use psb_descriptor_type, only : psb_desc_type + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info,nxch,nsnd,nrcv + integer, intent(in) :: index_in(:) + integer, allocatable, intent(inout) :: index_out(:) + logical :: glob_idx + end subroutine psi_crea_index + end interface + + interface + subroutine psi_crea_ovr_elem(me,desc_overlap,ovr_elem,info) + integer, intent(in) :: me, desc_overlap(:) + integer, allocatable, intent(out) :: ovr_elem(:,:) + integer, intent(out) :: info + end subroutine psi_crea_ovr_elem + end interface + + interface + subroutine psi_desc_index(desc,index_in,dep_list,& + & length_dl,nsnd,nrcv,desc_index,isglob_in,info) + use psb_descriptor_type, only : psb_desc_type + type(psb_desc_type) :: desc + integer :: index_in(:),dep_list(:) + integer,allocatable :: desc_index(:) + integer :: length_dl,nsnd,nrcv,info + logical :: isglob_in + end subroutine psi_desc_index + end interface + + interface + subroutine psi_dl_check(dep_list,dl_lda,np,length_dl) + integer :: np,dl_lda,length_dl(0:np) + integer :: dep_list(dl_lda,0:np) + end subroutine psi_dl_check + end interface + + interface + subroutine psi_sort_dl(dep_list,l_dep_list,np,info) + integer :: np,dep_list(:,:), l_dep_list(:), info + end subroutine psi_sort_dl + end interface + + interface + subroutine psi_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,& + & length_dl,np,dl_lda,mode,info) + logical :: is_bld, is_upd + integer :: ictxt,np,dl_lda,mode, info + integer :: desc_str(*),dep_list(dl_lda,0:np),length_dl(0:np) + end subroutine psi_extract_dep_list + end interface + + interface psi_fnd_owner + subroutine psi_fnd_owner(nv,idx,iprc,desc,info) + use psb_descriptor_type, only : psb_desc_type + integer, intent(in) :: nv + integer, intent(in) :: idx(:) + integer, allocatable, intent(out) :: iprc(:) + type(psb_desc_type), intent(in) :: desc + integer, intent(out) :: info + end subroutine psi_fnd_owner + end interface psi_fnd_owner + + interface psi_ldsc_pre_halo + subroutine psi_ldsc_pre_halo(desc,ext_hv,info) + use psb_descriptor_type, only : psb_desc_type + type(psb_desc_type), intent(inout) :: desc + logical, intent(in) :: ext_hv + integer, intent(out) :: info + end subroutine psi_ldsc_pre_halo + end interface psi_ldsc_pre_halo + + interface psi_bld_tmphalo + subroutine psi_bld_tmphalo(desc,info) + use psb_descriptor_type, only : psb_desc_type + type(psb_desc_type), intent(inout) :: desc + integer, intent(out) :: info + end subroutine psi_bld_tmphalo + end interface psi_bld_tmphalo + + + interface psi_bld_tmpovrl + subroutine psi_bld_tmpovrl(iv,desc,info) + use psb_descriptor_type, only : psb_desc_type + integer, intent(in) :: iv(:) + type(psb_desc_type), intent(inout) :: desc + integer, intent(out) :: info + end subroutine psi_bld_tmpovrl + end interface psi_bld_tmpovrl + + + interface psi_idx_cnv + subroutine psi_idx_cnv1(nv,idxin,desc,info,mask,owned) + use psb_descriptor_type, only : psb_desc_type + integer, intent(in) :: nv + integer, intent(inout) :: idxin(:) + type(psb_desc_type), intent(in) :: desc + integer, intent(out) :: info + logical, intent(in), optional :: mask(:) + logical, intent(in), optional :: owned + end subroutine psi_idx_cnv1 + subroutine psi_idx_cnv2(nv,idxin,idxout,desc,info,mask,owned) + use psb_descriptor_type, only : psb_desc_type + integer, intent(in) :: nv, idxin(:) + integer, intent(out) :: idxout(:) + type(psb_desc_type), intent(in) :: desc + integer, intent(out) :: info + logical, intent(in), optional :: mask(:) + logical, intent(in), optional :: owned + end subroutine psi_idx_cnv2 + subroutine psi_idx_cnvs(idxin,idxout,desc,info,mask,owned) + use psb_descriptor_type, only : psb_desc_type + integer, intent(in) :: idxin + integer, intent(out) :: idxout + type(psb_desc_type), intent(in) :: desc + integer, intent(out) :: info + logical, intent(in), optional :: mask + logical, intent(in), optional :: owned + end subroutine psi_idx_cnvs + subroutine psi_idx_cnvs1(idxin,desc,info,mask,owned) + use psb_descriptor_type, only : psb_desc_type + integer, intent(inout) :: idxin + type(psb_desc_type), intent(in) :: desc + integer, intent(out) :: info + logical, intent(in), optional :: mask + logical, intent(in), optional :: owned + end subroutine psi_idx_cnvs1 + end interface psi_idx_cnv + + interface psi_idx_ins_cnv + subroutine psi_idx_ins_cnv1(nv,idxin,desc,info,mask) + use psb_descriptor_type, only : psb_desc_type + integer, intent(in) :: nv + integer, intent(inout) :: idxin(:) + type(psb_desc_type), intent(inout) :: desc + integer, intent(out) :: info + logical, intent(in), optional :: mask(:) + end subroutine psi_idx_ins_cnv1 + subroutine psi_idx_ins_cnv2(nv,idxin,idxout,desc,info,mask) + use psb_descriptor_type, only : psb_desc_type + integer, intent(in) :: nv, idxin(:) + integer, intent(out) :: idxout(:) + type(psb_desc_type), intent(inout) :: desc + integer, intent(out) :: info + logical, intent(in), optional :: mask(:) + end subroutine psi_idx_ins_cnv2 + subroutine psi_idx_ins_cnvs2(idxin,idxout,desc,info,mask) + use psb_descriptor_type, only : psb_desc_type + integer, intent(in) :: idxin + integer, intent(out) :: idxout + type(psb_desc_type), intent(inout) :: desc + integer, intent(out) :: info + logical, intent(in), optional :: mask + end subroutine psi_idx_ins_cnvs2 + subroutine psi_idx_ins_cnvs1(idxin,desc,info,mask) + use psb_descriptor_type, only : psb_desc_type + integer, intent(inout) :: idxin + type(psb_desc_type), intent(inout) :: desc + integer, intent(out) :: info + logical, intent(in), optional :: mask + end subroutine psi_idx_ins_cnvs1 + end interface psi_idx_ins_cnv + + interface psi_cnv_dsc + subroutine psi_cnv_dsc(halo_in,ovrlap_in,ext_in,cdesc, info) + use psb_descriptor_type, only: psb_desc_type + integer, intent(in) :: halo_in(:), ovrlap_in(:),ext_in(:) + type(psb_desc_type), intent(inout) :: cdesc + integer, intent(out) :: info + end subroutine psi_cnv_dsc + end interface psi_cnv_dsc + + interface psi_renum_index + subroutine psi_renum_index(iperm,idx,info) + integer, intent(out) :: info + integer, intent(in) :: iperm(:) + integer, intent(inout) :: idx(:) + end subroutine psi_renum_index + end interface psi_renum_index + + interface psi_inner_cnv + subroutine psi_inner_cnvs(x,hashmask,hashv,glb_lc) + integer, intent(in) :: hashmask,hashv(0:),glb_lc(:,:) + integer, intent(inout) :: x + end subroutine psi_inner_cnvs + subroutine psi_inner_cnvs2(x,y,hashmask,hashv,glb_lc) + integer, intent(in) :: hashmask,hashv(0:),glb_lc(:,:) + integer, intent(in) :: x + integer, intent(out) :: y + end subroutine psi_inner_cnvs2 + subroutine psi_inner_cnv1(n,x,hashmask,hashv,glb_lc,mask) + integer, intent(in) :: n,hashmask,hashv(0:),glb_lc(:,:) + logical, intent(in), optional :: mask(:) + integer, intent(inout) :: x(:) + end subroutine psi_inner_cnv1 + subroutine psi_inner_cnv2(n,x,y,hashmask,hashv,glb_lc,mask) + integer, intent(in) :: n, hashmask,hashv(0:),glb_lc(:,:) + logical, intent(in),optional :: mask(:) + integer, intent(in) :: x(:) + integer, intent(out) :: y(:) + end subroutine psi_inner_cnv2 + end interface psi_inner_cnv + + interface + subroutine psi_bld_ovr_mst(me,ovrlap_elem,mst_idx,info) + integer, intent(in) :: me, ovrlap_elem(:,:) + integer, allocatable, intent(out) :: mst_idx(:) + integer, intent(out) :: info + end subroutine psi_bld_ovr_mst + end interface + + + interface psi_swapdata + subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data) + use psb_descriptor_type, only : psb_desc_type + integer, intent(in) :: flag, n + integer, intent(out) :: info + integer :: y(:,:), beta + integer, target :: work(:) + type(psb_desc_type), target :: desc_a + integer, optional :: data + end subroutine psi_iswapdatam + subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data) + use psb_descriptor_type, only : psb_desc_type + integer, intent(in) :: flag + integer, intent(out) :: info + integer :: y(:), beta + integer, target :: work(:) + type(psb_desc_type), target :: desc_a + integer, optional :: data + end subroutine psi_iswapdatav + subroutine psi_iswapidxm(ictxt,icomm,flag,n,beta,y,idx,& + & totxch,totsnd,totrcv,work,info) + use psb_const_mod + integer, intent(in) :: ictxt,icomm,flag, n + integer, intent(out) :: info + integer :: y(:,:), beta + integer,target :: work(:) + integer, intent(in) :: idx(:),totxch,totsnd,totrcv + end subroutine psi_iswapidxm + subroutine psi_iswapidxv(ictxt,icomm,flag,beta,y,idx,& + & totxch,totsnd,totrcv,work,info) + use psb_const_mod + integer, intent(in) :: ictxt,icomm,flag + integer, intent(out) :: info + integer :: y(:), beta + integer,target :: work(:) + integer, intent(in) :: idx(:),totxch,totsnd,totrcv + end subroutine psi_iswapidxv + end interface psi_swapdata + + + interface psi_swaptran + subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data) + use psb_descriptor_type, only : psb_desc_type + integer, intent(in) :: flag, n + integer, intent(out) :: info + integer :: y(:,:), beta + integer,target :: work(:) + type(psb_desc_type), target :: desc_a + integer, optional :: data + end subroutine psi_iswaptranm + subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data) + use psb_descriptor_type, only : psb_desc_type + integer, intent(in) :: flag + integer, intent(out) :: info + integer :: y(:), beta + integer,target :: work(:) + type(psb_desc_type), target :: desc_a + integer, optional :: data + end subroutine psi_iswaptranv + subroutine psi_itranidxm(ictxt,icomm,flag,n,beta,y,idx,& + & totxch,totsnd,totrcv,work,info) + use psb_const_mod + integer, intent(in) :: ictxt,icomm,flag, n + integer, intent(out) :: info + integer :: y(:,:), beta + integer, target :: work(:) + integer, intent(in) :: idx(:),totxch,totsnd,totrcv + end subroutine psi_itranidxm + subroutine psi_itranidxv(ictxt,icomm,flag,beta,y,idx,& + & totxch,totsnd,totrcv,work,info) + use psb_const_mod + integer, intent(in) :: ictxt,icomm,flag + integer, intent(out) :: info + integer :: y(:), beta + integer, target :: work(:) + integer, intent(in) :: idx(:),totxch,totsnd,totrcv + end subroutine psi_itranidxv + end interface psi_swaptran + + interface psi_ovrl_upd + subroutine psi_iovrl_updr1(x,desc_a,update,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + integer, intent(inout), target :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(in) :: update + integer, intent(out) :: info + end subroutine psi_iovrl_updr1 + subroutine psi_iovrl_updr2(x,desc_a,update,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + integer, intent(inout), target :: x(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(in) :: update + integer, intent(out) :: info + end subroutine psi_iovrl_updr2 + end interface psi_ovrl_upd + + interface psi_ovrl_save + subroutine psi_iovrl_saver1(x,xs,desc_a,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + integer, intent(inout) :: x(:) + integer, allocatable :: xs(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + end subroutine psi_iovrl_saver1 + subroutine psi_iovrl_saver2(x,xs,desc_a,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + integer, intent(inout) :: x(:,:) + integer, allocatable :: xs(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + end subroutine psi_iovrl_saver2 + end interface psi_ovrl_save + + interface psi_ovrl_restore + subroutine psi_iovrl_restrr1(x,xs,desc_a,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + integer, intent(inout) :: x(:) + integer :: xs(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + end subroutine psi_iovrl_restrr1 + subroutine psi_iovrl_restrr2(x,xs,desc_a,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + integer, intent(inout) :: x(:,:) + integer :: xs(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + end subroutine psi_iovrl_restrr2 + end interface psi_ovrl_restore + +end module psi_i_mod + diff --git a/base/modules/psi_mod.f90 b/base/modules/psi_mod.f90 index 7fdcfedbd..c52f1f5d2 100644 --- a/base/modules/psi_mod.f90 +++ b/base/modules/psi_mod.f90 @@ -36,833 +36,11 @@ module psi_mod use psb_const_mod use psb_error_mod use psb_penv_mod + use psi_i_mod + use psi_s_mod + use psi_d_mod + use psi_c_mod + use psi_z_mod - - interface - subroutine psi_compute_size(desc_data,& - & index_in, dl_lda, info) - integer :: info, dl_lda - integer :: desc_data(:), index_in(:) - end subroutine psi_compute_size - end interface - - interface - subroutine psi_crea_bnd_elem(bndel,desc_a,info) - use psb_descriptor_type - integer, allocatable :: bndel(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - end subroutine psi_crea_bnd_elem - end interface - - interface - subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,nxch,nsnd,nrcv,info) - use psb_descriptor_type, only : psb_desc_type - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info,nxch,nsnd,nrcv - integer, intent(in) :: index_in(:) - integer, allocatable, intent(inout) :: index_out(:) - logical :: glob_idx - end subroutine psi_crea_index - end interface - - interface - subroutine psi_crea_ovr_elem(me,desc_overlap,ovr_elem,info) - integer, intent(in) :: me, desc_overlap(:) - integer, allocatable, intent(out) :: ovr_elem(:,:) - integer, intent(out) :: info - end subroutine psi_crea_ovr_elem - end interface - - interface - subroutine psi_desc_index(desc,index_in,dep_list,& - & length_dl,nsnd,nrcv,desc_index,isglob_in,info) - use psb_descriptor_type, only : psb_desc_type - type(psb_desc_type) :: desc - integer :: index_in(:),dep_list(:) - integer,allocatable :: desc_index(:) - integer :: length_dl,nsnd,nrcv,info - logical :: isglob_in - end subroutine psi_desc_index - end interface - - interface - subroutine psi_dl_check(dep_list,dl_lda,np,length_dl) - integer :: np,dl_lda,length_dl(0:np) - integer :: dep_list(dl_lda,0:np) - end subroutine psi_dl_check - end interface - - interface - subroutine psi_sort_dl(dep_list,l_dep_list,np,info) - integer :: np,dep_list(:,:), l_dep_list(:), info - end subroutine psi_sort_dl - end interface - - interface psi_swapdata - subroutine psi_sswapdatam(flag,n,beta,y,desc_a,work,info,data) - use psb_descriptor_type, only : psb_desc_type, psb_spk_ - integer, intent(in) :: flag, n - integer, intent(out) :: info - real(psb_spk_) :: y(:,:), beta - real(psb_spk_),target :: work(:) - type(psb_desc_type), target :: desc_a - integer, optional :: data - end subroutine psi_sswapdatam - subroutine psi_sswapdatav(flag,beta,y,desc_a,work,info,data) - use psb_descriptor_type, only : psb_desc_type, psb_spk_ - integer, intent(in) :: flag - integer, intent(out) :: info - real(psb_spk_) :: y(:), beta - real(psb_spk_),target :: work(:) - type(psb_desc_type), target :: desc_a - integer, optional :: data - end subroutine psi_sswapdatav - subroutine psi_sswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work,info) - use psb_const_mod - integer, intent(in) :: ictxt,icomm,flag, n - integer, intent(out) :: info - real(psb_spk_) :: y(:,:), beta - real(psb_spk_),target :: work(:) - integer, intent(in) :: idx(:),totxch,totsnd,totrcv - end subroutine psi_sswapidxm - subroutine psi_sswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info) - use psb_const_mod - integer, intent(in) :: ictxt,icomm,flag - integer, intent(out) :: info - real(psb_spk_) :: y(:), beta - real(psb_spk_),target :: work(:) - integer, intent(in) :: idx(:),totxch,totsnd,totrcv - end subroutine psi_sswapidxv - subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data) - use psb_descriptor_type, only : psb_desc_type, psb_dpk_ - integer, intent(in) :: flag, n - integer, intent(out) :: info - real(psb_dpk_) :: y(:,:), beta - real(psb_dpk_),target :: work(:) - type(psb_desc_type), target :: desc_a - integer, optional :: data - end subroutine psi_dswapdatam - subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data) - use psb_descriptor_type, only : psb_desc_type, psb_dpk_ - integer, intent(in) :: flag - integer, intent(out) :: info - real(psb_dpk_) :: y(:), beta - real(psb_dpk_),target :: work(:) - type(psb_desc_type), target :: desc_a - integer, optional :: data - end subroutine psi_dswapdatav - subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work,info) - use psb_const_mod - integer, intent(in) :: ictxt,icomm,flag, n - integer, intent(out) :: info - real(psb_dpk_) :: y(:,:), beta - real(psb_dpk_),target :: work(:) - integer, intent(in) :: idx(:),totxch,totsnd,totrcv - end subroutine psi_dswapidxm - subroutine psi_dswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info) - use psb_const_mod - integer, intent(in) :: ictxt,icomm,flag - integer, intent(out) :: info - real(psb_dpk_) :: y(:), beta - real(psb_dpk_),target :: work(:) - integer, intent(in) :: idx(:),totxch,totsnd,totrcv - end subroutine psi_dswapidxv - subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data) - use psb_descriptor_type, only : psb_desc_type - integer, intent(in) :: flag, n - integer, intent(out) :: info - integer :: y(:,:), beta - integer, target :: work(:) - type(psb_desc_type), target :: desc_a - integer, optional :: data - end subroutine psi_iswapdatam - subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data) - use psb_descriptor_type, only : psb_desc_type - integer, intent(in) :: flag - integer, intent(out) :: info - integer :: y(:), beta - integer, target :: work(:) - type(psb_desc_type), target :: desc_a - integer, optional :: data - end subroutine psi_iswapdatav - subroutine psi_iswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work,info) - use psb_const_mod - integer, intent(in) :: ictxt,icomm,flag, n - integer, intent(out) :: info - integer :: y(:,:), beta - integer,target :: work(:) - integer, intent(in) :: idx(:),totxch,totsnd,totrcv - end subroutine psi_iswapidxm - subroutine psi_iswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info) - use psb_const_mod - integer, intent(in) :: ictxt,icomm,flag - integer, intent(out) :: info - integer :: y(:), beta - integer,target :: work(:) - integer, intent(in) :: idx(:),totxch,totsnd,totrcv - end subroutine psi_iswapidxv - subroutine psi_cswapdatam(flag,n,beta,y,desc_a,work,info,data) - use psb_descriptor_type, only : psb_desc_type, psb_spk_ - integer, intent(in) :: flag, n - integer, intent(out) :: info - complex(psb_spk_) :: y(:,:), beta - complex(psb_spk_),target :: work(:) - type(psb_desc_type), target :: desc_a - integer, optional :: data - end subroutine psi_cswapdatam - subroutine psi_cswapdatav(flag,beta,y,desc_a,work,info,data) - use psb_descriptor_type, only : psb_desc_type, psb_spk_ - integer, intent(in) :: flag - integer, intent(out) :: info - complex(psb_spk_) :: y(:), beta - complex(psb_spk_),target :: work(:) - type(psb_desc_type), target :: desc_a - integer, optional :: data - end subroutine psi_cswapdatav - subroutine psi_cswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work,info) - use psb_const_mod - integer, intent(in) :: ictxt,icomm,flag, n - integer, intent(out) :: info - complex(psb_spk_) :: y(:,:), beta - complex(psb_spk_),target :: work(:) - integer, intent(in) :: idx(:),totxch,totsnd,totrcv - end subroutine psi_cswapidxm - subroutine psi_cswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info) - use psb_const_mod - integer, intent(in) :: ictxt,icomm,flag - integer, intent(out) :: info - complex(psb_spk_) :: y(:), beta - complex(psb_spk_),target :: work(:) - integer, intent(in) :: idx(:),totxch,totsnd,totrcv - end subroutine psi_cswapidxv - subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data) - use psb_descriptor_type, only : psb_desc_type, psb_dpk_ - integer, intent(in) :: flag, n - integer, intent(out) :: info - complex(psb_dpk_) :: y(:,:), beta - complex(psb_dpk_),target :: work(:) - type(psb_desc_type), target :: desc_a - integer, optional :: data - end subroutine psi_zswapdatam - subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data) - use psb_descriptor_type, only : psb_desc_type, psb_dpk_ - integer, intent(in) :: flag - integer, intent(out) :: info - complex(psb_dpk_) :: y(:), beta - complex(psb_dpk_),target :: work(:) - type(psb_desc_type), target :: desc_a - integer, optional :: data - end subroutine psi_zswapdatav - subroutine psi_zswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work,info) - use psb_const_mod - integer, intent(in) :: ictxt,icomm,flag, n - integer, intent(out) :: info - complex(psb_dpk_) :: y(:,:), beta - complex(psb_dpk_),target :: work(:) - integer, intent(in) :: idx(:),totxch,totsnd,totrcv - end subroutine psi_zswapidxm - subroutine psi_zswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info) - use psb_const_mod - integer, intent(in) :: ictxt,icomm,flag - integer, intent(out) :: info - complex(psb_dpk_) :: y(:), beta - complex(psb_dpk_),target :: work(:) - integer, intent(in) :: idx(:),totxch,totsnd,totrcv - end subroutine psi_zswapidxv - end interface - - - interface psi_swaptran - subroutine psi_sswaptranm(flag,n,beta,y,desc_a,work,info,data) - use psb_descriptor_type, only : psb_desc_type, psb_spk_ - integer, intent(in) :: flag, n - integer, intent(out) :: info - real(psb_spk_) :: y(:,:), beta - real(psb_spk_),target :: work(:) - type(psb_desc_type), target :: desc_a - integer, optional :: data - end subroutine psi_sswaptranm - subroutine psi_sswaptranv(flag,beta,y,desc_a,work,info,data) - use psb_descriptor_type, only : psb_desc_type, psb_spk_ - integer, intent(in) :: flag - integer, intent(out) :: info - real(psb_spk_) :: y(:), beta - real(psb_spk_),target :: work(:) - type(psb_desc_type), target :: desc_a - integer, optional :: data - end subroutine psi_sswaptranv - subroutine psi_stranidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work,info) - use psb_const_mod - integer, intent(in) :: ictxt,icomm,flag, n - integer, intent(out) :: info - real(psb_spk_) :: y(:,:), beta - real(psb_spk_),target :: work(:) - integer, intent(in) :: idx(:),totxch,totsnd,totrcv - end subroutine psi_stranidxm - subroutine psi_stranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info) - use psb_const_mod - integer, intent(in) :: ictxt,icomm,flag - integer, intent(out) :: info - real(psb_spk_) :: y(:), beta - real(psb_spk_),target :: work(:) - integer, intent(in) :: idx(:),totxch,totsnd,totrcv - end subroutine psi_stranidxv - subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data) - use psb_descriptor_type, only : psb_desc_type, psb_dpk_ - integer, intent(in) :: flag, n - integer, intent(out) :: info - real(psb_dpk_) :: y(:,:), beta - real(psb_dpk_),target :: work(:) - type(psb_desc_type), target :: desc_a - integer, optional :: data - end subroutine psi_dswaptranm - subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data) - use psb_descriptor_type, only : psb_desc_type, psb_dpk_ - integer, intent(in) :: flag - integer, intent(out) :: info - real(psb_dpk_) :: y(:), beta - real(psb_dpk_),target :: work(:) - type(psb_desc_type), target :: desc_a - integer, optional :: data - end subroutine psi_dswaptranv - subroutine psi_dtranidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work,info) - use psb_const_mod - integer, intent(in) :: ictxt,icomm,flag, n - integer, intent(out) :: info - real(psb_dpk_) :: y(:,:), beta - real(psb_dpk_),target :: work(:) - integer, intent(in) :: idx(:),totxch,totsnd,totrcv - end subroutine psi_dtranidxm - subroutine psi_dtranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info) - use psb_const_mod - integer, intent(in) :: ictxt,icomm,flag - integer, intent(out) :: info - real(psb_dpk_) :: y(:), beta - real(psb_dpk_),target :: work(:) - integer, intent(in) :: idx(:),totxch,totsnd,totrcv - end subroutine psi_dtranidxv - subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data) - use psb_descriptor_type, only : psb_desc_type - integer, intent(in) :: flag, n - integer, intent(out) :: info - integer :: y(:,:), beta - integer,target :: work(:) - type(psb_desc_type), target :: desc_a - integer, optional :: data - end subroutine psi_iswaptranm - subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data) - use psb_descriptor_type, only : psb_desc_type - integer, intent(in) :: flag - integer, intent(out) :: info - integer :: y(:), beta - integer,target :: work(:) - type(psb_desc_type), target :: desc_a - integer, optional :: data - end subroutine psi_iswaptranv - subroutine psi_itranidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work,info) - use psb_const_mod - integer, intent(in) :: ictxt,icomm,flag, n - integer, intent(out) :: info - integer :: y(:,:), beta - integer, target :: work(:) - integer, intent(in) :: idx(:),totxch,totsnd,totrcv - end subroutine psi_itranidxm - subroutine psi_itranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info) - use psb_const_mod - integer, intent(in) :: ictxt,icomm,flag - integer, intent(out) :: info - integer :: y(:), beta - integer, target :: work(:) - integer, intent(in) :: idx(:),totxch,totsnd,totrcv - end subroutine psi_itranidxv - subroutine psi_cswaptranm(flag,n,beta,y,desc_a,work,info,data) - use psb_descriptor_type, only : psb_desc_type, psb_spk_ - integer, intent(in) :: flag, n - integer, intent(out) :: info - complex(psb_spk_) :: y(:,:), beta - complex(psb_spk_),target :: work(:) - type(psb_desc_type), target :: desc_a - integer, optional :: data - end subroutine psi_cswaptranm - subroutine psi_cswaptranv(flag,beta,y,desc_a,work,info,data) - use psb_descriptor_type, only : psb_desc_type, psb_spk_ - integer, intent(in) :: flag - integer, intent(out) :: info - complex(psb_spk_) :: y(:), beta - complex(psb_spk_),target :: work(:) - type(psb_desc_type), target :: desc_a - integer, optional :: data - end subroutine psi_cswaptranv - subroutine psi_ctranidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work,info) - use psb_const_mod - integer, intent(in) :: ictxt,icomm,flag, n - integer, intent(out) :: info - complex(psb_spk_) :: y(:,:), beta - complex(psb_spk_), target :: work(:) - integer, intent(in) :: idx(:),totxch,totsnd,totrcv - end subroutine psi_ctranidxm - subroutine psi_ctranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info) - use psb_const_mod - integer, intent(in) :: ictxt,icomm,flag - integer, intent(out) :: info - complex(psb_spk_) :: y(:), beta - complex(psb_spk_), target :: work(:) - integer, intent(in) :: idx(:),totxch,totsnd,totrcv - end subroutine psi_ctranidxv - subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data) - use psb_descriptor_type, only : psb_desc_type, psb_dpk_ - integer, intent(in) :: flag, n - integer, intent(out) :: info - complex(psb_dpk_) :: y(:,:), beta - complex(psb_dpk_),target :: work(:) - type(psb_desc_type), target :: desc_a - integer, optional :: data - end subroutine psi_zswaptranm - subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data) - use psb_descriptor_type, only : psb_desc_type, psb_dpk_ - integer, intent(in) :: flag - integer, intent(out) :: info - complex(psb_dpk_) :: y(:), beta - complex(psb_dpk_),target :: work(:) - type(psb_desc_type), target :: desc_a - integer, optional :: data - end subroutine psi_zswaptranv - subroutine psi_ztranidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work,info) - use psb_const_mod - integer, intent(in) :: ictxt,icomm,flag, n - integer, intent(out) :: info - complex(psb_dpk_) :: y(:,:), beta - complex(psb_dpk_), target :: work(:) - integer, intent(in) :: idx(:),totxch,totsnd,totrcv - end subroutine psi_ztranidxm - subroutine psi_ztranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info) - use psb_const_mod - integer, intent(in) :: ictxt,icomm,flag - integer, intent(out) :: info - complex(psb_dpk_) :: y(:), beta - complex(psb_dpk_), target :: work(:) - integer, intent(in) :: idx(:),totxch,totsnd,totrcv - end subroutine psi_ztranidxv - end interface - - interface - subroutine psi_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,& - & length_dl,np,dl_lda,mode,info) - logical :: is_bld, is_upd - integer :: ictxt,np,dl_lda,mode, info - integer :: desc_str(*),dep_list(dl_lda,0:np),length_dl(0:np) - end subroutine psi_extract_dep_list - end interface - - interface psi_fnd_owner - subroutine psi_fnd_owner(nv,idx,iprc,desc,info) - use psb_descriptor_type, only : psb_desc_type - integer, intent(in) :: nv - integer, intent(in) :: idx(:) - integer, allocatable, intent(out) :: iprc(:) - type(psb_desc_type), intent(in) :: desc - integer, intent(out) :: info - end subroutine psi_fnd_owner - end interface - - interface psi_ldsc_pre_halo - subroutine psi_ldsc_pre_halo(desc,ext_hv,info) - use psb_descriptor_type, only : psb_desc_type - type(psb_desc_type), intent(inout) :: desc - logical, intent(in) :: ext_hv - integer, intent(out) :: info - end subroutine psi_ldsc_pre_halo - end interface - - interface psi_bld_tmphalo - subroutine psi_bld_tmphalo(desc,info) - use psb_descriptor_type, only : psb_desc_type - type(psb_desc_type), intent(inout) :: desc - integer, intent(out) :: info - end subroutine psi_bld_tmphalo - end interface - - - interface psi_bld_tmpovrl - subroutine psi_bld_tmpovrl(iv,desc,info) - use psb_descriptor_type, only : psb_desc_type - integer, intent(in) :: iv(:) - type(psb_desc_type), intent(inout) :: desc - integer, intent(out) :: info - end subroutine psi_bld_tmpovrl - end interface - - - interface psi_idx_cnv - subroutine psi_idx_cnv1(nv,idxin,desc,info,mask,owned) - use psb_descriptor_type, only : psb_desc_type - integer, intent(in) :: nv - integer, intent(inout) :: idxin(:) - type(psb_desc_type), intent(in) :: desc - integer, intent(out) :: info - logical, intent(in), optional :: mask(:) - logical, intent(in), optional :: owned - end subroutine psi_idx_cnv1 - subroutine psi_idx_cnv2(nv,idxin,idxout,desc,info,mask,owned) - use psb_descriptor_type, only : psb_desc_type - integer, intent(in) :: nv, idxin(:) - integer, intent(out) :: idxout(:) - type(psb_desc_type), intent(in) :: desc - integer, intent(out) :: info - logical, intent(in), optional :: mask(:) - logical, intent(in), optional :: owned - end subroutine psi_idx_cnv2 - subroutine psi_idx_cnvs(idxin,idxout,desc,info,mask,owned) - use psb_descriptor_type, only : psb_desc_type - integer, intent(in) :: idxin - integer, intent(out) :: idxout - type(psb_desc_type), intent(in) :: desc - integer, intent(out) :: info - logical, intent(in), optional :: mask - logical, intent(in), optional :: owned - end subroutine psi_idx_cnvs - subroutine psi_idx_cnvs1(idxin,desc,info,mask,owned) - use psb_descriptor_type, only : psb_desc_type - integer, intent(inout) :: idxin - type(psb_desc_type), intent(in) :: desc - integer, intent(out) :: info - logical, intent(in), optional :: mask - logical, intent(in), optional :: owned - end subroutine psi_idx_cnvs1 - end interface - - interface psi_idx_ins_cnv - subroutine psi_idx_ins_cnv1(nv,idxin,desc,info,mask) - use psb_descriptor_type, only : psb_desc_type - integer, intent(in) :: nv - integer, intent(inout) :: idxin(:) - type(psb_desc_type), intent(inout) :: desc - integer, intent(out) :: info - logical, intent(in), optional :: mask(:) - end subroutine psi_idx_ins_cnv1 - subroutine psi_idx_ins_cnv2(nv,idxin,idxout,desc,info,mask) - use psb_descriptor_type, only : psb_desc_type - integer, intent(in) :: nv, idxin(:) - integer, intent(out) :: idxout(:) - type(psb_desc_type), intent(inout) :: desc - integer, intent(out) :: info - logical, intent(in), optional :: mask(:) - end subroutine psi_idx_ins_cnv2 - subroutine psi_idx_ins_cnvs2(idxin,idxout,desc,info,mask) - use psb_descriptor_type, only : psb_desc_type - integer, intent(in) :: idxin - integer, intent(out) :: idxout - type(psb_desc_type), intent(inout) :: desc - integer, intent(out) :: info - logical, intent(in), optional :: mask - end subroutine psi_idx_ins_cnvs2 - subroutine psi_idx_ins_cnvs1(idxin,desc,info,mask) - use psb_descriptor_type, only : psb_desc_type - integer, intent(inout) :: idxin - type(psb_desc_type), intent(inout) :: desc - integer, intent(out) :: info - logical, intent(in), optional :: mask - end subroutine psi_idx_ins_cnvs1 - end interface - - interface psi_cnv_dsc - subroutine psi_cnv_dsc(halo_in,ovrlap_in,ext_in,cdesc, info) - use psb_descriptor_type, only: psb_desc_type - integer, intent(in) :: halo_in(:), ovrlap_in(:),ext_in(:) - type(psb_desc_type), intent(inout) :: cdesc - integer, intent(out) :: info - end subroutine psi_cnv_dsc - end interface - - interface psi_renum_index - subroutine psi_renum_index(iperm,idx,info) - integer, intent(out) :: info - integer, intent(in) :: iperm(:) - integer, intent(inout) :: idx(:) - end subroutine psi_renum_index - end interface - - interface psi_inner_cnv - subroutine psi_inner_cnvs(x,hashmask,hashv,glb_lc) - integer, intent(in) :: hashmask,hashv(0:),glb_lc(:,:) - integer, intent(inout) :: x - end subroutine psi_inner_cnvs - subroutine psi_inner_cnvs2(x,y,hashmask,hashv,glb_lc) - integer, intent(in) :: hashmask,hashv(0:),glb_lc(:,:) - integer, intent(in) :: x - integer, intent(out) :: y - end subroutine psi_inner_cnvs2 - subroutine psi_inner_cnv1(n,x,hashmask,hashv,glb_lc,mask) - integer, intent(in) :: n,hashmask,hashv(0:),glb_lc(:,:) - logical, intent(in), optional :: mask(:) - integer, intent(inout) :: x(:) - end subroutine psi_inner_cnv1 - subroutine psi_inner_cnv2(n,x,y,hashmask,hashv,glb_lc,mask) - integer, intent(in) :: n, hashmask,hashv(0:),glb_lc(:,:) - logical, intent(in),optional :: mask(:) - integer, intent(in) :: x(:) - integer, intent(out) :: y(:) - end subroutine psi_inner_cnv2 - end interface - - interface psi_ovrl_upd - subroutine psi_iovrl_updr1(x,desc_a,update,info) - use psb_const_mod - use psb_descriptor_type, only: psb_desc_type - integer, intent(inout), target :: x(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(in) :: update - integer, intent(out) :: info - end subroutine psi_iovrl_updr1 - subroutine psi_iovrl_updr2(x,desc_a,update,info) - use psb_const_mod - use psb_descriptor_type, only: psb_desc_type - integer, intent(inout), target :: x(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(in) :: update - integer, intent(out) :: info - end subroutine psi_iovrl_updr2 - subroutine psi_sovrl_updr1(x,desc_a,update,info) - use psb_const_mod - use psb_descriptor_type, only: psb_desc_type - real(psb_spk_), intent(inout), target :: x(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(in) :: update - integer, intent(out) :: info - end subroutine psi_sovrl_updr1 - subroutine psi_sovrl_updr2(x,desc_a,update,info) - use psb_const_mod - use psb_descriptor_type, only: psb_desc_type - real(psb_spk_), intent(inout), target :: x(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(in) :: update - integer, intent(out) :: info - end subroutine psi_sovrl_updr2 - subroutine psi_dovrl_updr1(x,desc_a,update,info) - use psb_const_mod - use psb_descriptor_type, only: psb_desc_type - real(psb_dpk_), intent(inout), target :: x(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(in) :: update - integer, intent(out) :: info - end subroutine psi_dovrl_updr1 - subroutine psi_dovrl_updr2(x,desc_a,update,info) - use psb_const_mod - use psb_descriptor_type, only: psb_desc_type - real(psb_dpk_), intent(inout), target :: x(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(in) :: update - integer, intent(out) :: info - end subroutine psi_dovrl_updr2 - subroutine psi_covrl_updr1(x,desc_a,update,info) - use psb_const_mod - use psb_descriptor_type, only: psb_desc_type - complex(psb_spk_), intent(inout), target :: x(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(in) :: update - integer, intent(out) :: info - end subroutine psi_covrl_updr1 - subroutine psi_covrl_updr2(x,desc_a,update,info) - use psb_const_mod - use psb_descriptor_type, only: psb_desc_type - complex(psb_spk_), intent(inout), target :: x(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(in) :: update - integer, intent(out) :: info - end subroutine psi_covrl_updr2 - subroutine psi_zovrl_updr1(x,desc_a,update,info) - use psb_const_mod - use psb_descriptor_type, only: psb_desc_type - complex(psb_dpk_), intent(inout), target :: x(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(in) :: update - integer, intent(out) :: info - end subroutine psi_zovrl_updr1 - subroutine psi_zovrl_updr2(x,desc_a,update,info) - use psb_const_mod - use psb_descriptor_type, only: psb_desc_type - complex(psb_dpk_), intent(inout), target :: x(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(in) :: update - integer, intent(out) :: info - end subroutine psi_zovrl_updr2 - - end interface - - interface psi_ovrl_save - subroutine psi_iovrl_saver1(x,xs,desc_a,info) - use psb_const_mod - use psb_descriptor_type, only: psb_desc_type - integer, intent(inout) :: x(:) - integer, allocatable :: xs(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - end subroutine psi_iovrl_saver1 - subroutine psi_iovrl_saver2(x,xs,desc_a,info) - use psb_const_mod - use psb_descriptor_type, only: psb_desc_type - integer, intent(inout) :: x(:,:) - integer, allocatable :: xs(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - end subroutine psi_iovrl_saver2 - subroutine psi_sovrl_saver1(x,xs,desc_a,info) - use psb_const_mod - use psb_descriptor_type, only: psb_desc_type - real(psb_spk_), intent(inout) :: x(:) - real(psb_spk_), allocatable :: xs(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - end subroutine psi_sovrl_saver1 - subroutine psi_sovrl_saver2(x,xs,desc_a,info) - use psb_const_mod - use psb_descriptor_type, only: psb_desc_type - real(psb_spk_), intent(inout) :: x(:,:) - real(psb_spk_), allocatable :: xs(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - end subroutine psi_sovrl_saver2 - subroutine psi_dovrl_saver1(x,xs,desc_a,info) - use psb_const_mod - use psb_descriptor_type, only: psb_desc_type - real(psb_dpk_), intent(inout) :: x(:) - real(psb_dpk_), allocatable :: xs(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - end subroutine psi_dovrl_saver1 - subroutine psi_dovrl_saver2(x,xs,desc_a,info) - use psb_const_mod - use psb_descriptor_type, only: psb_desc_type - real(psb_dpk_), intent(inout) :: x(:,:) - real(psb_dpk_), allocatable :: xs(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - end subroutine psi_dovrl_saver2 - subroutine psi_covrl_saver1(x,xs,desc_a,info) - use psb_const_mod - use psb_descriptor_type, only: psb_desc_type - complex(psb_spk_), intent(inout) :: x(:) - complex(psb_spk_), allocatable :: xs(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - end subroutine psi_covrl_saver1 - subroutine psi_covrl_saver2(x,xs,desc_a,info) - use psb_const_mod - use psb_descriptor_type, only: psb_desc_type - complex(psb_spk_), intent(inout) :: x(:,:) - complex(psb_spk_), allocatable :: xs(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - end subroutine psi_covrl_saver2 - subroutine psi_zovrl_saver1(x,xs,desc_a,info) - use psb_const_mod - use psb_descriptor_type, only: psb_desc_type - complex(psb_dpk_), intent(inout) :: x(:) - complex(psb_dpk_), allocatable :: xs(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - end subroutine psi_zovrl_saver1 - subroutine psi_zovrl_saver2(x,xs,desc_a,info) - use psb_const_mod - use psb_descriptor_type, only: psb_desc_type - complex(psb_dpk_), intent(inout) :: x(:,:) - complex(psb_dpk_), allocatable :: xs(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - end subroutine psi_zovrl_saver2 - end interface - - interface psi_ovrl_restore - subroutine psi_iovrl_restrr1(x,xs,desc_a,info) - use psb_const_mod - use psb_descriptor_type, only: psb_desc_type - integer, intent(inout) :: x(:) - integer :: xs(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - end subroutine psi_iovrl_restrr1 - subroutine psi_iovrl_restrr2(x,xs,desc_a,info) - use psb_const_mod - use psb_descriptor_type, only: psb_desc_type - integer, intent(inout) :: x(:,:) - integer :: xs(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - end subroutine psi_iovrl_restrr2 - subroutine psi_sovrl_restrr1(x,xs,desc_a,info) - use psb_const_mod - use psb_descriptor_type, only: psb_desc_type - real(psb_spk_), intent(inout) :: x(:) - real(psb_spk_) :: xs(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - end subroutine psi_sovrl_restrr1 - subroutine psi_sovrl_restrr2(x,xs,desc_a,info) - use psb_const_mod - use psb_descriptor_type, only: psb_desc_type - real(psb_spk_), intent(inout) :: x(:,:) - real(psb_spk_) :: xs(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - end subroutine psi_sovrl_restrr2 - subroutine psi_dovrl_restrr1(x,xs,desc_a,info) - use psb_const_mod - use psb_descriptor_type, only: psb_desc_type - real(psb_dpk_), intent(inout) :: x(:) - real(psb_dpk_) :: xs(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - end subroutine psi_dovrl_restrr1 - subroutine psi_dovrl_restrr2(x,xs,desc_a,info) - use psb_const_mod - use psb_descriptor_type, only: psb_desc_type - real(psb_dpk_), intent(inout) :: x(:,:) - real(psb_dpk_) :: xs(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - end subroutine psi_dovrl_restrr2 - subroutine psi_covrl_restrr1(x,xs,desc_a,info) - use psb_const_mod - use psb_descriptor_type, only: psb_desc_type - complex(psb_spk_), intent(inout) :: x(:) - complex(psb_spk_) :: xs(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - end subroutine psi_covrl_restrr1 - subroutine psi_covrl_restrr2(x,xs,desc_a,info) - use psb_const_mod - use psb_descriptor_type, only: psb_desc_type - complex(psb_spk_), intent(inout) :: x(:,:) - complex(psb_spk_) :: xs(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - end subroutine psi_covrl_restrr2 - subroutine psi_zovrl_restrr1(x,xs,desc_a,info) - use psb_const_mod - use psb_descriptor_type, only: psb_desc_type - complex(psb_dpk_), intent(inout) :: x(:) - complex(psb_dpk_) :: xs(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - end subroutine psi_zovrl_restrr1 - subroutine psi_zovrl_restrr2(x,xs,desc_a,info) - use psb_const_mod - use psb_descriptor_type, only: psb_desc_type - complex(psb_dpk_), intent(inout) :: x(:,:) - complex(psb_dpk_) :: xs(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - end subroutine psi_zovrl_restrr2 - end interface - - interface - subroutine psi_bld_ovr_mst(me,ovrlap_elem,mst_idx,info) - integer, intent(in) :: me, ovrlap_elem(:,:) - integer, allocatable, intent(out) :: mst_idx(:) - integer, intent(out) :: info - end subroutine psi_bld_ovr_mst - end interface - end module psi_mod diff --git a/base/modules/psi_penv_mod.F90 b/base/modules/psi_penv_mod.F90 index 04b1df556..148c188b7 100644 --- a/base/modules/psi_penv_mod.F90 +++ b/base/modules/psi_penv_mod.F90 @@ -333,15 +333,15 @@ contains integer :: code, info +#if defined(SERIAL_MPI) + stop +#else if (present(errc)) then code = errc else code = -1 endif -#if defined(SERIAL_MPI) - stop -#else call mpi_abort(ictxt,code,info) #endif diff --git a/base/modules/psi_s_mod.f90 b/base/modules/psi_s_mod.f90 new file mode 100644 index 000000000..738cbbde2 --- /dev/null +++ b/base/modules/psi_s_mod.f90 @@ -0,0 +1,242 @@ +!!$ +!!$ Parallel Sparse BLAS version 3.0 +!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +module psi_s_mod + + interface psi_swapdata + subroutine psi_sswapdatam(flag,n,beta,y,desc_a,work,info,data) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + integer, intent(in) :: flag, n + integer, intent(out) :: info + real(psb_spk_) :: y(:,:), beta + real(psb_spk_),target :: work(:) + type(psb_desc_type), target :: desc_a + integer, optional :: data + end subroutine psi_sswapdatam + subroutine psi_sswapdatav(flag,beta,y,desc_a,work,info,data) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + integer, intent(in) :: flag + integer, intent(out) :: info + real(psb_spk_) :: y(:), beta + real(psb_spk_),target :: work(:) + type(psb_desc_type), target :: desc_a + integer, optional :: data + end subroutine psi_sswapdatav + subroutine psi_sswapdata_vect(flag,beta,y,desc_a,work,info,data) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + use psb_s_base_vect_mod + integer, intent(in) :: flag + integer, intent(out) :: info + class(psb_s_base_vect_type) :: y + real(psb_spk_) :: beta + real(psb_spk_),target :: work(:) + type(psb_desc_type), target :: desc_a + integer, optional :: data + end subroutine psi_sswapdata_vect + subroutine psi_sswapidxm(ictxt,icomm,flag,n,beta,y,idx,& + & totxch,totsnd,totrcv,work,info) + use psb_const_mod + integer, intent(in) :: ictxt,icomm,flag, n + integer, intent(out) :: info + real(psb_spk_) :: y(:,:), beta + real(psb_spk_),target :: work(:) + integer, intent(in) :: idx(:),totxch,totsnd,totrcv + end subroutine psi_sswapidxm + subroutine psi_sswapidxv(ictxt,icomm,flag,beta,y,idx,& + & totxch,totsnd,totrcv,work,info) + use psb_const_mod + integer, intent(in) :: ictxt,icomm,flag + integer, intent(out) :: info + real(psb_spk_) :: y(:), beta + real(psb_spk_),target :: work(:) + integer, intent(in) :: idx(:),totxch,totsnd,totrcv + end subroutine psi_sswapidxv + subroutine psi_sswapidx_vect(ictxt,icomm,flag,beta,y,idx,& + & totxch,totsnd,totrcv,work,info) + use psb_const_mod + use psb_s_base_vect_mod + integer, intent(in) :: ictxt,icomm,flag + integer, intent(out) :: info + class(psb_s_base_vect_type) :: y + real(psb_spk_) :: beta + real(psb_spk_),target :: work(:) + integer, intent(in) :: idx(:),totxch,totsnd,totrcv + end subroutine psi_sswapidx_vect + end interface + + + interface psi_swaptran + subroutine psi_sswaptranm(flag,n,beta,y,desc_a,work,info,data) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + integer, intent(in) :: flag, n + integer, intent(out) :: info + real(psb_spk_) :: y(:,:), beta + real(psb_spk_),target :: work(:) + type(psb_desc_type), target :: desc_a + integer, optional :: data + end subroutine psi_sswaptranm + subroutine psi_sswaptranv(flag,beta,y,desc_a,work,info,data) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + integer, intent(in) :: flag + integer, intent(out) :: info + real(psb_spk_) :: y(:), beta + real(psb_spk_),target :: work(:) + type(psb_desc_type), target :: desc_a + integer, optional :: data + end subroutine psi_sswaptranv + subroutine psi_sswaptran_vect(flag,beta,y,desc_a,work,info,data) + use psb_descriptor_type, only : psb_desc_type, psb_spk_ + use psb_s_base_vect_mod + integer, intent(in) :: flag + integer, intent(out) :: info + class(psb_s_base_vect_type) :: y + real(psb_spk_) :: beta + real(psb_spk_),target :: work(:) + type(psb_desc_type), target :: desc_a + integer, optional :: data + end subroutine psi_sswaptran_vect + subroutine psi_stranidxm(ictxt,icomm,flag,n,beta,y,idx,& + & totxch,totsnd,totrcv,work,info) + use psb_const_mod + integer, intent(in) :: ictxt,icomm,flag, n + integer, intent(out) :: info + real(psb_spk_) :: y(:,:), beta + real(psb_spk_),target :: work(:) + integer, intent(in) :: idx(:),totxch,totsnd,totrcv + end subroutine psi_stranidxm + subroutine psi_stranidxv(ictxt,icomm,flag,beta,y,idx,& + & totxch,totsnd,totrcv,work,info) + use psb_const_mod + integer, intent(in) :: ictxt,icomm,flag + integer, intent(out) :: info + real(psb_spk_) :: y(:), beta + real(psb_spk_),target :: work(:) + integer, intent(in) :: idx(:),totxch,totsnd,totrcv + end subroutine psi_stranidxv + subroutine psi_stranidx_vect(ictxt,icomm,flag,beta,y,idx,& + & totxch,totsnd,totrcv,work,info) + use psb_const_mod + use psb_s_base_vect_mod + integer, intent(in) :: ictxt,icomm,flag + integer, intent(out) :: info + class(psb_s_base_vect_type) :: y + real(psb_spk_) :: beta + real(psb_spk_),target :: work(:) + integer, intent(in) :: idx(:),totxch,totsnd,totrcv + end subroutine psi_stranidx_vect + end interface + + interface psi_ovrl_upd + subroutine psi_sovrl_updr1(x,desc_a,update,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + real(psb_spk_), intent(inout), target :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(in) :: update + integer, intent(out) :: info + end subroutine psi_sovrl_updr1 + subroutine psi_sovrl_updr2(x,desc_a,update,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + real(psb_spk_), intent(inout), target :: x(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(in) :: update + integer, intent(out) :: info + end subroutine psi_sovrl_updr2 + subroutine psi_sovrl_upd_vect(x,desc_a,update,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + use psb_s_base_vect_mod + class(psb_s_base_vect_type) :: x + type(psb_desc_type), intent(in) :: desc_a + integer, intent(in) :: update + integer, intent(out) :: info + end subroutine psi_sovrl_upd_vect + end interface + + interface psi_ovrl_save + subroutine psi_sovrl_saver1(x,xs,desc_a,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + real(psb_spk_), intent(inout) :: x(:) + real(psb_spk_), allocatable :: xs(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + end subroutine psi_sovrl_saver1 + subroutine psi_sovrl_saver2(x,xs,desc_a,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + real(psb_spk_), intent(inout) :: x(:,:) + real(psb_spk_), allocatable :: xs(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + end subroutine psi_sovrl_saver2 + subroutine psi_sovrl_save_vect(x,xs,desc_a,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + use psb_s_base_vect_mod + class(psb_s_base_vect_type) :: x + real(psb_spk_), allocatable :: xs(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + end subroutine psi_sovrl_save_vect + end interface + + interface psi_ovrl_restore + subroutine psi_sovrl_restrr1(x,xs,desc_a,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + real(psb_spk_), intent(inout) :: x(:) + real(psb_spk_) :: xs(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + end subroutine psi_sovrl_restrr1 + subroutine psi_sovrl_restrr2(x,xs,desc_a,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + real(psb_spk_), intent(inout) :: x(:,:) + real(psb_spk_) :: xs(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + end subroutine psi_sovrl_restrr2 + subroutine psi_sovrl_restr_vect(x,xs,desc_a,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + use psb_s_base_vect_mod + class(psb_s_base_vect_type) :: x + real(psb_spk_) :: xs(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + end subroutine psi_sovrl_restr_vect + end interface + +end module psi_s_mod + diff --git a/base/modules/psi_z_mod.f90 b/base/modules/psi_z_mod.f90 new file mode 100644 index 000000000..57fd3917b --- /dev/null +++ b/base/modules/psi_z_mod.f90 @@ -0,0 +1,242 @@ +!!$ +!!$ Parallel Sparse BLAS version 3.0 +!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +module psi_z_mod + + interface psi_swapdata + subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + integer, intent(in) :: flag, n + integer, intent(out) :: info + complex(psb_dpk_) :: y(:,:), beta + complex(psb_dpk_),target :: work(:) + type(psb_desc_type), target :: desc_a + integer, optional :: data + end subroutine psi_zswapdatam + subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + integer, intent(in) :: flag + integer, intent(out) :: info + complex(psb_dpk_) :: y(:), beta + complex(psb_dpk_),target :: work(:) + type(psb_desc_type), target :: desc_a + integer, optional :: data + end subroutine psi_zswapdatav + subroutine psi_zswapdata_vect(flag,beta,y,desc_a,work,info,data) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + use psb_z_base_vect_mod + integer, intent(in) :: flag + integer, intent(out) :: info + class(psb_z_base_vect_type) :: y + complex(psb_dpk_) :: beta + complex(psb_dpk_),target :: work(:) + type(psb_desc_type), target :: desc_a + integer, optional :: data + end subroutine psi_zswapdata_vect + subroutine psi_zswapidxm(ictxt,icomm,flag,n,beta,y,idx,& + & totxch,totsnd,totrcv,work,info) + use psb_const_mod + integer, intent(in) :: ictxt,icomm,flag, n + integer, intent(out) :: info + complex(psb_dpk_) :: y(:,:), beta + complex(psb_dpk_),target :: work(:) + integer, intent(in) :: idx(:),totxch,totsnd,totrcv + end subroutine psi_zswapidxm + subroutine psi_zswapidxv(ictxt,icomm,flag,beta,y,idx,& + & totxch,totsnd,totrcv,work,info) + use psb_const_mod + integer, intent(in) :: ictxt,icomm,flag + integer, intent(out) :: info + complex(psb_dpk_) :: y(:), beta + complex(psb_dpk_),target :: work(:) + integer, intent(in) :: idx(:),totxch,totsnd,totrcv + end subroutine psi_zswapidxv + subroutine psi_zswapidx_vect(ictxt,icomm,flag,beta,y,idx,& + & totxch,totsnd,totrcv,work,info) + use psb_const_mod + use psb_z_base_vect_mod + integer, intent(in) :: ictxt,icomm,flag + integer, intent(out) :: info + class(psb_z_base_vect_type) :: y + complex(psb_dpk_) :: beta + complex(psb_dpk_),target :: work(:) + integer, intent(in) :: idx(:),totxch,totsnd,totrcv + end subroutine psi_zswapidx_vect + end interface + + + interface psi_swaptran + subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + integer, intent(in) :: flag, n + integer, intent(out) :: info + complex(psb_dpk_) :: y(:,:), beta + complex(psb_dpk_),target :: work(:) + type(psb_desc_type), target :: desc_a + integer, optional :: data + end subroutine psi_zswaptranm + subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + integer, intent(in) :: flag + integer, intent(out) :: info + complex(psb_dpk_) :: y(:), beta + complex(psb_dpk_),target :: work(:) + type(psb_desc_type), target :: desc_a + integer, optional :: data + end subroutine psi_zswaptranv + subroutine psi_zswaptran_vect(flag,beta,y,desc_a,work,info,data) + use psb_descriptor_type, only : psb_desc_type, psb_dpk_ + use psb_z_base_vect_mod + integer, intent(in) :: flag + integer, intent(out) :: info + class(psb_z_base_vect_type) :: y + complex(psb_dpk_) :: beta + complex(psb_dpk_),target :: work(:) + type(psb_desc_type), target :: desc_a + integer, optional :: data + end subroutine psi_zswaptran_vect + subroutine psi_ztranidxm(ictxt,icomm,flag,n,beta,y,idx,& + & totxch,totsnd,totrcv,work,info) + use psb_const_mod + integer, intent(in) :: ictxt,icomm,flag, n + integer, intent(out) :: info + complex(psb_dpk_) :: y(:,:), beta + complex(psb_dpk_),target :: work(:) + integer, intent(in) :: idx(:),totxch,totsnd,totrcv + end subroutine psi_ztranidxm + subroutine psi_ztranidxv(ictxt,icomm,flag,beta,y,idx,& + & totxch,totsnd,totrcv,work,info) + use psb_const_mod + integer, intent(in) :: ictxt,icomm,flag + integer, intent(out) :: info + complex(psb_dpk_) :: y(:), beta + complex(psb_dpk_),target :: work(:) + integer, intent(in) :: idx(:),totxch,totsnd,totrcv + end subroutine psi_ztranidxv + subroutine psi_ztranidx_vect(ictxt,icomm,flag,beta,y,idx,& + & totxch,totsnd,totrcv,work,info) + use psb_const_mod + use psb_z_base_vect_mod + integer, intent(in) :: ictxt,icomm,flag + integer, intent(out) :: info + class(psb_z_base_vect_type) :: y + complex(psb_dpk_) :: beta + complex(psb_dpk_),target :: work(:) + integer, intent(in) :: idx(:),totxch,totsnd,totrcv + end subroutine psi_ztranidx_vect + end interface + + interface psi_ovrl_upd + subroutine psi_zovrl_updr1(x,desc_a,update,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + complex(psb_dpk_), intent(inout), target :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(in) :: update + integer, intent(out) :: info + end subroutine psi_zovrl_updr1 + subroutine psi_zovrl_updr2(x,desc_a,update,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + complex(psb_dpk_), intent(inout), target :: x(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(in) :: update + integer, intent(out) :: info + end subroutine psi_zovrl_updr2 + subroutine psi_zovrl_upd_vect(x,desc_a,update,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + use psb_z_base_vect_mod + class(psb_z_base_vect_type) :: x + type(psb_desc_type), intent(in) :: desc_a + integer, intent(in) :: update + integer, intent(out) :: info + end subroutine psi_zovrl_upd_vect + end interface + + interface psi_ovrl_save + subroutine psi_zovrl_saver1(x,xs,desc_a,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + complex(psb_dpk_), intent(inout) :: x(:) + complex(psb_dpk_), allocatable :: xs(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + end subroutine psi_zovrl_saver1 + subroutine psi_zovrl_saver2(x,xs,desc_a,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + complex(psb_dpk_), intent(inout) :: x(:,:) + complex(psb_dpk_), allocatable :: xs(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + end subroutine psi_zovrl_saver2 + subroutine psi_zovrl_save_vect(x,xs,desc_a,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + use psb_z_base_vect_mod + class(psb_z_base_vect_type) :: x + complex(psb_dpk_), allocatable :: xs(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + end subroutine psi_zovrl_save_vect + end interface + + interface psi_ovrl_restore + subroutine psi_zovrl_restrr1(x,xs,desc_a,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + complex(psb_dpk_), intent(inout) :: x(:) + complex(psb_dpk_) :: xs(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + end subroutine psi_zovrl_restrr1 + subroutine psi_zovrl_restrr2(x,xs,desc_a,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + complex(psb_dpk_), intent(inout) :: x(:,:) + complex(psb_dpk_) :: xs(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + end subroutine psi_zovrl_restrr2 + subroutine psi_zovrl_restr_vect(x,xs,desc_a,info) + use psb_const_mod + use psb_descriptor_type, only: psb_desc_type + use psb_z_base_vect_mod + class(psb_z_base_vect_type) :: x + complex(psb_dpk_) :: xs(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + end subroutine psi_zovrl_restr_vect + end interface + +end module psi_z_mod + diff --git a/base/psblas/psb_camax.f90 b/base/psblas/psb_camax.f90 index 98fbb59f9..0b4154814 100644 --- a/base/psblas/psb_camax.f90 +++ b/base/psblas/psb_camax.f90 @@ -256,6 +256,94 @@ function psb_camaxv (x,desc_a, info) return end function psb_camaxv + +function psb_camax_vect(x, desc_a, info) result(res) + use psb_penv_mod + use psb_serial_mod + use psb_descriptor_type + use psb_check_mod + use psb_error_mod + use psb_c_vect_mod + implicit none + + real(psb_spk_) :: res + type(psb_c_vect_type), intent (inout) :: x + type(psb_desc_type), intent (in) :: desc_a + integer, intent(out) :: info + + ! locals + integer :: ictxt, np, me,& + & err_act, iix, jjx, jx, ix, m, imax, isamax + real(psb_spk_) :: amax + character(len=20) :: name, ch_err + + name='psb_camaxv' + if(psb_get_errstatus() /= 0) return + info=psb_success_ + call psb_erractionsave(err_act) + + amax=szero + ictxt=desc_a%get_context() + + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + ix = 1 + jx = 1 + + m = desc_a%get_global_rows() + + call psb_chkvect(m,1,x%get_nrows(),ix,jx,desc_a,info,iix,jjx) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if (iix /= 1) then + info=psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + goto 9999 + end if + + ! compute local max + if ((desc_a%get_local_rows() > 0).and.(m /= 0)) then + amax=x%amax(desc_a%get_local_rows()) + else + amax = szero + end if + + ! compute global max + call psb_amx(ictxt, amax) + + res=amax + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end function psb_camax_vect + + !!$ !!$ Parallel Sparse BLAS version 3.0 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 diff --git a/base/psblas/psb_casum.f90 b/base/psblas/psb_casum.f90 index 1475f8e8b..4923bd08d 100644 --- a/base/psblas/psb_casum.f90 +++ b/base/psblas/psb_casum.f90 @@ -144,6 +144,96 @@ function psb_casum (x,desc_a, info, jx) end function psb_casum +function psb_casum_vect(x, desc_a, info) result(res) + use psb_penv_mod + use psb_serial_mod + use psb_descriptor_type + use psb_check_mod + use psb_error_mod + use psb_c_vect_mod + implicit none + + real(psb_spk_) :: res + type(psb_c_vect_type), intent (inout) :: x + type(psb_desc_type), intent (in) :: desc_a + integer, intent(out) :: info + + ! locals + integer :: ictxt, np, me,& + & err_act, iix, jjx, jx, ix, m, imax + real(psb_spk_) :: asum + character(len=20) :: name, ch_err + + name='psb_casumv' + if (psb_errstatus_fatal()) return + info=psb_success_ + call psb_erractionsave(err_act) + + asum=0.d0 + + ictxt=desc_a%get_context() + + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + ix = 1 + jx = 1 + + m = desc_a%get_global_rows() + + call psb_chkvect(m,1,x%get_nrows(),ix,jx,desc_a,info,iix,jjx) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if (iix /= 1) then + info=psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + goto 9999 + end if + + ! compute local max + if ((desc_a%get_local_rows() > 0).and.(m /= 0)) then + asum=x%asum(desc_a%get_local_rows()) + else + asum = szero + end if + + ! compute global sum + call psb_sum(ictxt, asum) + + res=asum + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end function psb_casum_vect + + + !!$ !!$ Parallel Sparse BLAS version 3.0 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 diff --git a/base/psblas/psb_caxpby.f90 b/base/psblas/psb_caxpby.f90 index f9d4763b3..02a54d392 100644 --- a/base/psblas/psb_caxpby.f90 +++ b/base/psblas/psb_caxpby.f90 @@ -30,6 +30,92 @@ !!$ !!$ ! File: psb_caxpby.f90 + +subroutine psb_caxpby_vect(alpha, x, beta, y,& + & desc_a, info) + use psb_base_mod, psb_protect_name => psb_caxpby_vect + implicit none + type(psb_c_vect_type), intent (inout) :: x + type(psb_c_vect_type), intent (inout) :: y + complex(psb_spk_), intent (in) :: alpha, beta + type(psb_desc_type), intent (in) :: desc_a + integer, intent(out) :: info + + ! locals + integer :: ictxt, np, me,& + & err_act, iix, jjx, ix, iy, m, iiy, jjy + character(len=20) :: name, ch_err + + name='psb_cgeaxpby' + if (psb_errstatus_fatal()) return + info=psb_success_ + call psb_erractionsave(err_act) + + ictxt=desc_a%get_context() + + call psb_info(ictxt, me, np) + if (np == -ione) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(y%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + ix = ione + iy = ione + + m = desc_a%get_global_rows() + + ! check vector correctness + call psb_chkvect(m,ione,x%get_nrows(),ix,ione,desc_a,info,iix,jjx) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect 1' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + call psb_chkvect(m,ione,y%get_nrows(),iy,ione,desc_a,info,iiy,jjy) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect 2' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if ((iix /= ione).or.(iiy /= ione)) then + info=psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + end if + + if(desc_a%get_local_rows() > 0) then + call y%axpby(desc_a%get_local_rows(),& + & alpha,x,beta,info) + 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(ictxt) + return + end if + return + +end subroutine psb_caxpby_vect + ! ! Subroutine: psb_caxpby ! Adds one distributed matrix to another, diff --git a/base/psblas/psb_cdot.f90 b/base/psblas/psb_cdot.f90 index fd5fde72a..cd7a95726 100644 --- a/base/psblas/psb_cdot.f90 +++ b/base/psblas/psb_cdot.f90 @@ -48,6 +48,112 @@ ! jx - integer(optional). The column offset for sub( X ). ! jy - integer(optional). The column offset for sub( Y ). ! +function psb_cdot_vect(x, y, desc_a,info) result(res) + use psb_descriptor_type + use psb_c_base_mat_mod + use psb_check_mod + use psb_error_mod + use psb_penv_mod + use psb_c_vect_mod + use psb_c_psblas_mod, psb_protect_name => psb_cdot_vect + implicit none + complex(psb_spk_) :: res + type(psb_c_vect_type), intent(inout) :: x, y + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + + ! locals + integer :: ictxt, np, me, idx, ndm,& + & err_act, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, nr + complex(psb_spk_) :: dot_local + character(len=20) :: name, ch_err + + name='psb_sdot' + res = szero + if (psb_errstatus_fatal()) return + info=psb_success_ + call psb_erractionsave(err_act) + + ictxt=desc_a%get_context() + call psb_info(ictxt, me, np) + if (np == -ione) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(y%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + ix = ione + ijx = ione + + iy = ione + ijy = ione + + m = desc_a%get_global_rows() + + ! check vector correctness + call psb_chkvect(m,ione,x%get_nrows(),ix,ijx,desc_a,info,iix,jjx) + if (info == psb_success_) & + & call psb_chkvect(m,ione,y%get_nrows(),iy,ijy,desc_a,info,iiy,jjy) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if ((iix /= ione).or.(iiy /= ione)) then + info=psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + goto 9999 + end if + + if(m /= 0) then + nr = desc_a%get_local_rows() + if(nr > 0) then + dot_local = x%dot(nr,y) +!!$ ! adjust dot_local because overlapped elements are computed more than once +!!$ do i=1,size(desc_a%ovrlap_elem,1) +!!$ idx = desc_a%ovrlap_elem(i,1) +!!$ ndm = desc_a%ovrlap_elem(i,2) +!!$ dot_local = dot_local - (real(ndm-1)/real(ndm))*(x(idx)*y(idx)) +!!$ end do + else + dot_local=czero + end if + else + dot_local=czero + end if + + ! compute global sum + call psb_sum(ictxt, dot_local) + + res = dot_local + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end function psb_cdot_vect + function psb_cdot(x, y,desc_a, info, jx, jy) use psb_base_mod, psb_protect_name => psb_cdot implicit none @@ -61,8 +167,8 @@ function psb_cdot(x, y,desc_a, info, jx, jy) ! locals integer :: ictxt, np, me, idx, ndm,& & err_act, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, nr - complex(psb_spk_) :: dot_local - complex(psb_spk_) :: cdotc + complex(psb_spk_) :: dot_local + complex(psb_spk_) :: cdotc character(len=20) :: name, ch_err name='psb_cdot' diff --git a/base/psblas/psb_cnrm2.f90 b/base/psblas/psb_cnrm2.f90 index a7d36168c..670774ec1 100644 --- a/base/psblas/psb_cnrm2.f90 +++ b/base/psblas/psb_cnrm2.f90 @@ -270,6 +270,101 @@ end function psb_cnrm2v +function psb_cnrm2_vect(x, desc_a, info) result(res) + use psb_descriptor_type + use psb_check_mod + use psb_error_mod + use psb_penv_mod + use psb_c_vect_mod + implicit none + + real(psb_spk_) :: res + type(psb_c_vect_type), intent (inout) :: x + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + + ! locals + integer :: ictxt, np, me,& + & err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm + real(psb_spk_) :: nrm2, snrm2, dd +!!$ external dcombnrm2 + character(len=20) :: name, ch_err + + name='psb_cnrm2v' + if (psb_errstatus_fatal()) return + info=psb_success_ + call psb_erractionsave(err_act) + + ictxt=desc_a%get_context() + + call psb_info(ictxt, me, np) + if (np == -1) then + info=psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + ix = 1 + jx=1 + m = desc_a%get_global_rows() + + call psb_chkvect(m,1,x%get_nrows(),ix,jx,desc_a,info,iix,jjx) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect' + call psb_errpush(info,name,a_err=ch_err) + end if + + if (iix /= 1) then + info=psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + goto 9999 + end if + + if(m /= 0) then + if (desc_a%get_local_rows() > 0) then + ndim = desc_a%get_local_rows() + nrm2 = x%nrm2(ndim) +!!$ ! adjust because overlapped elements are computed more than once +!!$ do i=1,size(desc_a%ovrlap_elem,1) +!!$ idx = desc_a%ovrlap_elem(i,1) +!!$ ndm = desc_a%ovrlap_elem(i,2) +!!$ dd = dble(ndm-1)/dble(ndm) +!!$ nrm2 = nrm2 * sqrt(done - dd*(abs(x(idx))/nrm2)**2) +!!$ end do + else + nrm2 = szero + end if + else + nrm2 = szero + end if + +!!$ call pdtreecomb(ictxt,'All',1,nrm2,-1,-1,dcombnrm2) + call psb_nrm2(ictxt,nrm2) + + res = nrm2 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return +end function psb_cnrm2_vect + + !!$ !!$ Parallel Sparse BLAS version 3.0 diff --git a/base/psblas/psb_cspmm.f90 b/base/psblas/psb_cspmm.f90 index 6a80d389f..95fff3ab4 100644 --- a/base/psblas/psb_cspmm.f90 +++ b/base/psblas/psb_cspmm.f90 @@ -672,3 +672,275 @@ subroutine psb_cspmv(alpha,a,x,beta,y,desc_a,info,& end if return end subroutine psb_cspmv + + + +subroutine psb_cspmv_vect(alpha,a,x,beta,y,desc_a,info,& + & trans, work, doswap) + use psb_base_mod, psb_protect_name => psb_cspmv_vect + use psi_mod + implicit none + + complex(psb_spk_), intent(in) :: alpha, beta + type(psb_c_vect_type), intent(inout) :: x + type(psb_c_vect_type), intent(inout) :: y + type(psb_cspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + complex(psb_spk_), optional, target, intent(inout) :: work(:) + character, intent(in), optional :: trans + logical, intent(in), optional :: doswap + + ! locals + integer :: ictxt, np, me,& + & err_act, n, iix, jjx, ia, ja, iia, jja, ix, iy, ik, & + & m, nrow, ncol, lldx, lldy, liwork, jx, jy, iiy, jjy,& + & ib, ip, idx + integer, parameter :: nb=4 + complex(psb_spk_), pointer :: iwork(:), xp(:), yp(:) + complex(psb_spk_), allocatable :: xvsave(:) + character :: trans_ + character(len=20) :: name, ch_err + logical :: aliw, doswap_ + integer :: debug_level, debug_unit + + name='psb_cspmv' + if (psb_errstatus_fatal()) return + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt=desc_a%get_context() + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(y%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + ia = 1 + ja = 1 + ix = 1 + jx = 1 + iy = 1 + jy = 1 + ik = 1 + ib = 1 + + if (present(doswap)) then + doswap_ = doswap + else + doswap_ = .true. + endif + + if (present(trans)) then + trans_ = psb_toupper(trans) + else + trans_ = 'N' + endif + if ( (trans_ == 'N').or.(trans_ == 'T')& + & .or.(trans_ == 'C')) then + else + info = psb_err_iarg_invalid_value_ + call psb_errpush(info,name) + goto 9999 + end if + + m = desc_a%get_global_rows() + n = desc_a%get_global_cols() + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + lldx = x%get_nrows() + lldy = y%get_nrows() + + iwork => null() + ! check for presence/size of a work area + liwork= 2*ncol + + if (present(work)) then + if (size(work) >= liwork) then + aliw =.false. + else + aliw=.true. + endif + else + aliw=.true. + end if + + if (aliw) then + allocate(iwork(liwork),stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='Allocate' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + else + iwork => work + endif + + if (debug_level >= psb_debug_comp_) & + & write(debug_unit,*) me,' ',trim(name),' Allocated work ', info + ! checking for matrix correctness + call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkmat' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if (debug_level >= psb_debug_comp_) & + & write(debug_unit,*) me,' ',trim(name),' Checkmat ', info + if (trans_ == 'N') then + ! Matrix is not transposed + if((ja /= ix).or.(ia /= iy)) then + ! this case is not yet implemented + info = psb_err_ja_nix_ia_niy_unsupported_ + call psb_errpush(info,name) + goto 9999 + end if + + ! checking for vectors correctness + call psb_chkvect(n,ik,x%get_nrows(),ix,jx,desc_a,info,iix,jjx) + if (info == psb_success_) & + & call psb_chkvect(m,ik,y%get_nrows(),iy,jy,desc_a,info,iiy,jjy) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if((iix /= 1).or.(iiy /= 1)) then + ! this case is not yet implemented + info = psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + goto 9999 + end if + + if (doswap_) then + call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),& + & czero,x%v,desc_a,iwork,info,data=psb_comm_halo_) + end if + + call psb_csmm(alpha,a,x,beta,y,info) + + if(info /= psb_success_) then + info = psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + else + ! Matrix is transposed + if((ja /= iy).or.(ia /= ix)) then + ! this case is not yet implemented + info = psb_err_ja_nix_ia_niy_unsupported_ + call psb_errpush(info,name) + goto 9999 + end if + + ! checking for vectors correctness + call psb_chkvect(m,ik,x%get_nrows(),ix,jx,desc_a,info,iix,jjx) + if (info == psb_success_)& + & call psb_chkvect(n,ik,y%get_nrows(),iy,jy,desc_a,info,iiy,jjy) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if((iix /= 1).or.(iiy /= 1)) then + ! this case is not yet implemented + info = psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + goto 9999 + end if + + + ! + ! Non-empty overlap, need a buffer to hold + ! the entries updated with average operator. + ! Why the average? because in this way they will contribute + ! with a proper scale factor (1/np) to the overall product. + ! + call psi_ovrl_save(x%v,xvsave,desc_a,info) + if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,psb_avg_,info) +!!! THIS SHOULD BE FIXED !!! But beta is almost never /= 0 +!!$ yp(nrow+1:ncol) = szero + + ! local Matrix-vector product + if (info == psb_success_) call psb_csmm(alpha,a,x,beta,y,info,trans=trans_) + + if (debug_level >= psb_debug_comp_) & + & write(debug_unit,*) me,' ',trim(name),' csmm ', info + + if (info == psb_success_) call psi_ovrl_restore(x%v,xvsave,desc_a,info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + ch_err='psb_csmm' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if (doswap_) then + call psi_swaptran(ior(psb_swap_send_,psb_swap_recv_),& + & cone,y%v,desc_a,iwork,info) + if (info == psb_success_) call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),& + & cone,y%v,desc_a,iwork,info,data=psb_comm_ovr_) + + if (debug_level >= psb_debug_comp_) & + & write(debug_unit,*) me,' ',trim(name),' swaptran ', info + if(info /= psb_success_) then + info = psb_err_from_subroutine_ + ch_err='PSI_SwapTran' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + end if + + end if + + if (aliw) deallocate(iwork,stat=info) + if (debug_level >= psb_debug_comp_) & + & write(debug_unit,*) me,' ',trim(name),' deallocat ',aliw, info + if(info /= psb_success_) then + info = psb_err_from_subroutine_ + ch_err='Deallocate iwork' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + nullify(iwork) + + call psb_erractionrestore(err_act) + if (debug_level >= psb_debug_comp_) then + call psb_barrier(ictxt) + write(debug_unit,*) me,' ',trim(name),' Returning ' + endif + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return +end subroutine psb_cspmv_vect diff --git a/base/psblas/psb_cspsm.f90 b/base/psblas/psb_cspsm.f90 index 8c086be55..a06bbe33d 100644 --- a/base/psblas/psb_cspsm.f90 +++ b/base/psblas/psb_cspsm.f90 @@ -549,3 +549,204 @@ subroutine psb_cspsv(alpha,a,x,beta,y,desc_a,info,& return end subroutine psb_cspsv + +subroutine psb_cspsv_vect(alpha,a,x,beta,y,desc_a,info,& + & trans, scale, choice, diag, work) + use psb_base_mod, psb_protect_name => psb_cspsv_vect + use psi_mod + implicit none + + complex(psb_spk_), intent(in) :: alpha, beta + type(psb_c_vect_type), intent(inout) :: x + type(psb_c_vect_type), intent(inout) :: y + type(psb_cspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + type(psb_c_vect_type), intent(inout), optional :: diag + complex(psb_spk_), optional, target, intent(inout) :: work(:) + character, intent(in), optional :: trans, scale + integer, intent(in), optional :: choice + + ! locals + integer :: ictxt, np, me, & + & err_act, iix, jjx, ia, ja, iia, jja, lldx,lldy, choice_,& + & ix, iy, ik, jx, jy, i, lld,& + & m, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm + + character :: lscale + integer, parameter :: nb=4 + complex(psb_spk_),pointer :: iwork(:), xp(:), yp(:) + character :: itrans + character(len=20) :: name, ch_err + logical :: aliw + + name='psb_sspsv' + if (psb_errstatus_fatal()) return + info=psb_success_ + call psb_erractionsave(err_act) + + ictxt=desc_a%get_context() + + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(y%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + ! just this case right now + ia = 1 + ja = 1 + ix = 1 + iy = 1 + ik = 1 + jx = 1 + jy = 1 + + if (present(choice)) then + choice_ = choice + else + choice_ = psb_avg_ + endif + + if (present(scale)) then + lscale = psb_toupper(scale) + else + lscale = 'U' + endif + + if (present(trans)) then + itrans = psb_toupper(trans) + if((itrans == 'N').or.(itrans == 'T').or.(itrans == 'C')) then + ! Ok + else + info = psb_err_iarg_invalid_value_ + call psb_errpush(info,name) + goto 9999 + end if + else + itrans = 'N' + endif + + m = desc_a%get_global_rows() + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + lldx = x%get_nrows() + lldy = y%get_nrows() + + if((lldx < ncol).or.(lldy < ncol)) then + info=psb_err_lld_case_not_implemented_ + call psb_errpush(info,name) + goto 9999 + end if + + iwork => null() + ! check for presence/size of a work area + liwork= 2*ncol + + if (present(work)) then + if (size(work) >= liwork) then + aliw =.false. + else + aliw=.true. + endif + else + aliw=.true. + end if + + if (aliw) then + allocate(iwork(liwork),stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_realloc' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + else + iwork => work + endif + + iwork(1)=0.d0 + + ! checking for matrix correctness + call psb_chkmat(m,m,ia,ja,desc_a,info,iia,jja) + ! checking for vectors correctness + if (info == psb_success_) & + & call psb_chkvect(m,ik,x%get_nrows(),ix,jx,desc_a,info,iix,jjx) + if (info == psb_success_)& + & call psb_chkvect(m,ik,y%get_nrows(),iy,jy,desc_a,info,iiy,jjy) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect/mat' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if(ja /= ix) then + ! this case is not yet implemented + info = psb_err_ja_nix_ia_niy_unsupported_ + end if + + if((iix /= 1).or.(iiy /= 1)) then + ! this case is not yet implemented + info = psb_err_ix_n1_iy_n1_unsupported_ + end if + + if(info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + + ! Perform local triangular system solve + if (present(diag)) then + call a%cssm(alpha,x,beta,y,info,scale=scale,d=diag,trans=trans) + else + call a%cssm(alpha,x,beta,y,info,scale=scale,trans=trans) + end if + if(info /= psb_success_) then + info = psb_err_from_subroutine_ + ch_err='dcssm' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + ! update overlap elements + if (choice_ > 0) then + call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),& + & cone,y%v,desc_a,iwork,info,data=psb_comm_ovr_) + + + if (info == psb_success_) call psi_ovrl_upd(y%v,desc_a,choice_,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='Inner updates') + goto 9999 + end if + end if + + if (aliw) deallocate(iwork) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return +end subroutine psb_cspsv_vect + diff --git a/base/psblas/psb_damax.f90 b/base/psblas/psb_damax.f90 index 7dd54d943..65332f348 100644 --- a/base/psblas/psb_damax.f90 +++ b/base/psblas/psb_damax.f90 @@ -254,6 +254,93 @@ function psb_damaxv (x,desc_a, info) return end function psb_damaxv +function psb_damax_vect(x, desc_a, info) result(res) + use psb_penv_mod + use psb_serial_mod + use psb_descriptor_type + use psb_check_mod + use psb_error_mod + use psb_d_vect_mod + implicit none + + real(psb_dpk_) :: res + type(psb_d_vect_type), intent (inout) :: x + type(psb_desc_type), intent (in) :: desc_a + integer, intent(out) :: info + + ! locals + integer :: ictxt, np, me,& + & err_act, iix, jjx, jx, ix, m, imax, idamax + real(psb_dpk_) :: amax + character(len=20) :: name, ch_err + + name='psb_damaxv' + if(psb_get_errstatus() /= 0) return + info=psb_success_ + call psb_erractionsave(err_act) + + amax=0.d0 + ictxt=desc_a%get_context() + + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + ix = 1 + jx = 1 + + m = desc_a%get_global_rows() + + call psb_chkvect(m,1,x%get_nrows(),ix,jx,desc_a,info,iix,jjx) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if (iix /= 1) then + info=psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + goto 9999 + end if + + ! compute local max + if ((desc_a%get_local_rows() > 0).and.(m /= 0)) then + amax=x%amax(desc_a%get_local_rows()) + else + amax = dzero + end if + + ! compute global max + call psb_amx(ictxt, amax) + + res=amax + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end function psb_damax_vect + + !!$ !!$ Parallel Sparse BLAS version 3.0 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 @@ -437,7 +524,7 @@ subroutine psb_dmamaxs (res,x,desc_a, info,jx) character(len=20) :: name, ch_err name='psb_dmamaxs' - if (psb_get_errstatus() /= 0) return + if (psb_errstatus_fatal()) return info=psb_success_ call psb_erractionsave(err_act) diff --git a/base/psblas/psb_dasum.f90 b/base/psblas/psb_dasum.f90 index 89d8980fe..0203df8a3 100644 --- a/base/psblas/psb_dasum.f90 +++ b/base/psblas/psb_dasum.f90 @@ -66,7 +66,7 @@ function psb_dasum (x,desc_a, info, jx) character(len=20) :: name, ch_err name='psb_dasum' - if(psb_get_errstatus() /= 0) return + if (psb_get_errstatus() /= 0) return info=psb_success_ call psb_erractionsave(err_act) @@ -282,6 +282,96 @@ function psb_dasumv (x,desc_a, info) end function psb_dasumv +function psb_dasum_vect(x, desc_a, info) result(res) + use psb_penv_mod + use psb_serial_mod + use psb_descriptor_type + use psb_check_mod + use psb_error_mod + use psb_d_vect_mod + implicit none + + real(psb_dpk_) :: res + type(psb_d_vect_type), intent (inout) :: x + type(psb_desc_type), intent (in) :: desc_a + integer, intent(out) :: info + + ! locals + integer :: ictxt, np, me,& + & err_act, iix, jjx, jx, ix, m, imax + real(psb_dpk_) :: asum + character(len=20) :: name, ch_err + + name='psb_dasumv' + if (psb_errstatus_fatal()) return + info=psb_success_ + call psb_erractionsave(err_act) + + asum=0.d0 + + ictxt=desc_a%get_context() + + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + ix = 1 + jx = 1 + + m = desc_a%get_global_rows() + + call psb_chkvect(m,1,x%get_nrows(),ix,jx,desc_a,info,iix,jjx) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if (iix /= 1) then + info=psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + goto 9999 + end if + + ! compute local max + if ((desc_a%get_local_rows() > 0).and.(m /= 0)) then + asum=x%asum(desc_a%get_local_rows()) + else + asum = dzero + end if + + ! compute global sum + call psb_sum(ictxt, asum) + + res=asum + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end function psb_dasum_vect + + + !!$ !!$ Parallel Sparse BLAS version 3.0 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 @@ -341,7 +431,7 @@ subroutine psb_dasumvs(res,x,desc_a, info) character(len=20) :: name, ch_err name='psb_dasumvs' - if(psb_get_errstatus() /= 0) return + if (psb_errstatus_fatal()) return info=psb_success_ call psb_erractionsave(err_act) @@ -415,3 +505,7 @@ subroutine psb_dasumvs(res,x,desc_a, info) end if return end subroutine psb_dasumvs + + + + diff --git a/base/psblas/psb_daxpby.f90 b/base/psblas/psb_daxpby.f90 index 73b382d47..1c40a75de 100644 --- a/base/psblas/psb_daxpby.f90 +++ b/base/psblas/psb_daxpby.f90 @@ -30,6 +30,93 @@ !!$ !!$ ! File: psb_daxpby.f90 + + +subroutine psb_daxpby_vect(alpha, x, beta, y,& + & desc_a, info) + use psb_base_mod, psb_protect_name => psb_daxpby_vect + implicit none + type(psb_d_vect_type), intent (inout) :: x + type(psb_d_vect_type), intent (inout) :: y + real(psb_dpk_), intent (in) :: alpha, beta + type(psb_desc_type), intent (in) :: desc_a + integer, intent(out) :: info + + ! locals + integer :: ictxt, np, me,& + & err_act, iix, jjx, ix, iy, m, iiy, jjy + character(len=20) :: name, ch_err + + name='psb_dgeaxpby' + if (psb_errstatus_fatal()) return + info=psb_success_ + call psb_erractionsave(err_act) + + ictxt=desc_a%get_context() + + call psb_info(ictxt, me, np) + if (np == -ione) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(y%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + ix = ione + iy = ione + + m = desc_a%get_global_rows() + + ! check vector correctness + call psb_chkvect(m,ione,x%get_nrows(),ix,ione,desc_a,info,iix,jjx) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect 1' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + call psb_chkvect(m,ione,y%get_nrows(),iy,ione,desc_a,info,iiy,jjy) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect 2' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if ((iix /= ione).or.(iiy /= ione)) then + info=psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + end if + + if(desc_a%get_local_rows() > 0) then + call y%axpby(desc_a%get_local_rows(),& + & alpha,x,beta,info) + 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(ictxt) + return + end if + return + +end subroutine psb_daxpby_vect + ! ! Subroutine: psb_daxpby ! Adds one distributed matrix to another, @@ -67,7 +154,7 @@ subroutine psb_daxpby(alpha, x, beta,y,desc_a,info, n, jx, jy) character(len=20) :: name, ch_err name='psb_dgeaxpby' - if(psb_get_errstatus() /= 0) return + if (psb_errstatus_fatal()) return info=psb_success_ call psb_erractionsave(err_act) @@ -217,7 +304,7 @@ subroutine psb_daxpbyv(alpha, x, beta,y,desc_a,info) character(len=20) :: name, ch_err name='psb_dgeaxpby' - if(psb_get_errstatus() /= 0) return + if (psb_errstatus_fatal()) return info=psb_success_ call psb_erractionsave(err_act) diff --git a/base/psblas/psb_ddot.f90 b/base/psblas/psb_ddot.f90 index 5e0304a37..5d05cf320 100644 --- a/base/psblas/psb_ddot.f90 +++ b/base/psblas/psb_ddot.f90 @@ -48,6 +48,113 @@ ! jx - integer(optional). The column offset for sub( X ). ! jy - integer(optional). The column offset for sub( Y ). ! +function psb_ddot_vect(x, y, desc_a,info) result(res) + use psb_descriptor_type + use psb_d_base_mat_mod + use psb_check_mod + use psb_error_mod + use psb_penv_mod + use psb_d_vect_mod + use psb_d_psblas_mod, psb_protect_name => psb_ddot_vect + implicit none + real(psb_dpk_) :: res + type(psb_d_vect_type), intent(inout) :: x, y + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + + ! locals + integer :: ictxt, np, me, idx, ndm,& + & err_act, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, nr + real(psb_dpk_) :: dot_local + real(psb_dpk_) :: ddot + character(len=20) :: name, ch_err + + name='psb_ddot' + res = dzero + if (psb_errstatus_fatal()) return + info=psb_success_ + call psb_erractionsave(err_act) + + ictxt=desc_a%get_context() + call psb_info(ictxt, me, np) + if (np == -ione) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(y%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + ix = ione + ijx = ione + + iy = ione + ijy = ione + + m = desc_a%get_global_rows() + + ! check vector correctness + call psb_chkvect(m,ione,x%get_nrows(),ix,ijx,desc_a,info,iix,jjx) + if (info == psb_success_) & + & call psb_chkvect(m,ione,y%get_nrows(),iy,ijy,desc_a,info,iiy,jjy) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if ((iix /= ione).or.(iiy /= ione)) then + info=psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + goto 9999 + end if + + if(m /= 0) then + nr = desc_a%get_local_rows() + if(nr > 0) then + dot_local = x%dot(nr,y) +!!$ ! adjust dot_local because overlapped elements are computed more than once +!!$ do i=1,size(desc_a%ovrlap_elem,1) +!!$ idx = desc_a%ovrlap_elem(i,1) +!!$ ndm = desc_a%ovrlap_elem(i,2) +!!$ dot_local = dot_local - (real(ndm-1)/real(ndm))*(x(idx)*y(idx)) +!!$ end do + else + dot_local=dzero + end if + else + dot_local=dzero + end if + + ! compute global sum + call psb_sum(ictxt, dot_local) + + res = dot_local + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end function psb_ddot_vect + function psb_ddot(x, y,desc_a, info, jx, jy) use psb_descriptor_type use psb_check_mod @@ -69,7 +176,7 @@ function psb_ddot(x, y,desc_a, info, jx, jy) character(len=20) :: name, ch_err name='psb_ddot' - if(psb_get_errstatus() /= 0) return + if (psb_errstatus_fatal()) return info=psb_success_ call psb_erractionsave(err_act) @@ -221,7 +328,7 @@ function psb_ddotv(x, y,desc_a, info) character(len=20) :: name, ch_err name='psb_ddot' - if(psb_get_errstatus() /= 0) return + if (psb_errstatus_fatal()) return info=psb_success_ call psb_erractionsave(err_act) @@ -356,7 +463,7 @@ subroutine psb_ddotvs(res, x, y,desc_a, info) character(len=20) :: name, ch_err name='psb_ddot' - if(psb_get_errstatus() /= 0) return + if (psb_errstatus_fatal()) return info=psb_success_ call psb_erractionsave(err_act) @@ -488,7 +595,7 @@ subroutine psb_dmdots(res, x, y, desc_a, info) character(len=20) :: name, ch_err name='psb_dmdots' - if(psb_get_errstatus() /= 0) return + if (psb_errstatus_fatal()) return info=psb_success_ call psb_erractionsave(err_act) diff --git a/base/psblas/psb_dnrm2.f90 b/base/psblas/psb_dnrm2.f90 index ab7dffe44..264dedb4e 100644 --- a/base/psblas/psb_dnrm2.f90 +++ b/base/psblas/psb_dnrm2.f90 @@ -65,7 +65,7 @@ function psb_dnrm2(x, desc_a, info, jx) character(len=20) :: name, ch_err name='psb_dnrm2' - if(psb_get_errstatus() /= 0) return + if (psb_errstatus_fatal()) return info=psb_success_ call psb_erractionsave(err_act) @@ -200,7 +200,7 @@ function psb_dnrm2v(x, desc_a, info) character(len=20) :: name, ch_err name='psb_dnrm2v' - if(psb_get_errstatus() /= 0) return + if (psb_errstatus_fatal()) return info=psb_success_ call psb_erractionsave(err_act) @@ -267,6 +267,102 @@ function psb_dnrm2v(x, desc_a, info) end function psb_dnrm2v +function psb_dnrm2_vect(x, desc_a, info) result(res) + use psb_descriptor_type + use psb_check_mod + use psb_error_mod + use psb_penv_mod + use psb_d_vect_mod + implicit none + + real(psb_dpk_) :: res + type(psb_d_vect_type), intent (inout) :: x + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + + ! locals + integer :: ictxt, np, me,& + & err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm + real(psb_dpk_) :: nrm2, dnrm2, dd +!!$ external dcombnrm2 + character(len=20) :: name, ch_err + + name='psb_dnrm2v' + if (psb_errstatus_fatal()) return + info=psb_success_ + call psb_erractionsave(err_act) + + ictxt=desc_a%get_context() + + call psb_info(ictxt, me, np) + if (np == -1) then + info=psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + ix = 1 + jx=1 + m = desc_a%get_global_rows() + + call psb_chkvect(m,1,x%get_nrows(),ix,jx,desc_a,info,iix,jjx) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect' + call psb_errpush(info,name,a_err=ch_err) + end if + + if (iix /= 1) then + info=psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + goto 9999 + end if + + if(m /= 0) then + if (desc_a%get_local_rows() > 0) then + ndim = desc_a%get_local_rows() + nrm2 = x%nrm2(ndim) +!!$ ! adjust because overlapped elements are computed more than once +!!$ do i=1,size(desc_a%ovrlap_elem,1) +!!$ idx = desc_a%ovrlap_elem(i,1) +!!$ ndm = desc_a%ovrlap_elem(i,2) +!!$ dd = dble(ndm-1)/dble(ndm) +!!$ nrm2 = nrm2 * sqrt(done - dd*(abs(x(idx))/nrm2)**2) +!!$ end do + else + nrm2 = dzero + end if + else + nrm2 = dzero + end if + +!!$ call pdtreecomb(ictxt,'All',1,nrm2,-1,-1,dcombnrm2) + call psb_nrm2(ictxt,nrm2) + + res = nrm2 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return +end function psb_dnrm2_vect + + + !!$ @@ -332,7 +428,7 @@ subroutine psb_dnrm2vs(res, x, desc_a, info) character(len=20) :: name, ch_err name='psb_dnrm2' - if(psb_get_errstatus() /= 0) return + if (psb_errstatus_fatal()) return info=psb_success_ call psb_erractionsave(err_act) diff --git a/base/psblas/psb_dnrmi.f90 b/base/psblas/psb_dnrmi.f90 index 5e747db23..6d6d3adff 100644 --- a/base/psblas/psb_dnrmi.f90 +++ b/base/psblas/psb_dnrmi.f90 @@ -62,7 +62,8 @@ function psb_dnrmi(a,desc_a,info) character(len=20) :: name, ch_err name='psb_dnrmi' - if(psb_get_errstatus() /= 0) return + psb_dnrmi = dzero + if (psb_errstatus_fatal()) return info=psb_success_ call psb_erractionsave(err_act) diff --git a/base/psblas/psb_dspmm.f90 b/base/psblas/psb_dspmm.f90 index f0c40be9c..cd1a0b598 100644 --- a/base/psblas/psb_dspmm.f90 +++ b/base/psblas/psb_dspmm.f90 @@ -93,7 +93,7 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,& integer :: debug_level, debug_unit name='psb_dspmm' - if(psb_get_errstatus() /= 0) return + if (psb_errstatus_fatal()) return info=psb_success_ call psb_erractionsave(err_act) debug_unit = psb_get_debug_unit() @@ -304,7 +304,8 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,& if (info == psb_success_) call psi_ovrl_upd(x,desc_a,psb_avg_,info) y(nrow+1:ncol,1:ik) = dzero - if (info == psb_success_) call psb_csmm(alpha,a,x(:,1:ik),beta,y(:,1:ik),info,trans=trans_) + if (info == psb_success_)& + & call psb_csmm(alpha,a,x(:,1:ik),beta,y(:,1:ik),info,trans=trans_) if (debug_level >= psb_debug_comp_) & & write(debug_unit,*) me,' ',trim(name),' csmm ', info if (info /= psb_success_) then @@ -444,7 +445,7 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,& integer :: debug_level, debug_unit name='psb_dspmv' - if(psb_get_errstatus() /= 0) return + if (psb_errstatus_fatal()) return info=psb_success_ call psb_erractionsave(err_act) debug_unit = psb_get_debug_unit() @@ -672,3 +673,275 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,& end if return end subroutine psb_dspmv + + + +subroutine psb_dspmv_vect(alpha,a,x,beta,y,desc_a,info,& + & trans, work, doswap) + use psb_base_mod, psb_protect_name => psb_dspmv_vect + use psi_mod + implicit none + + real(psb_dpk_), intent(in) :: alpha, beta + type(psb_d_vect_type), intent(inout) :: x + type(psb_d_vect_type), intent(inout) :: y + type(psb_dspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + real(psb_dpk_), optional, target, intent(inout) :: work(:) + character, intent(in), optional :: trans + logical, intent(in), optional :: doswap + + ! locals + integer :: ictxt, np, me,& + & err_act, n, iix, jjx, ia, ja, iia, jja, ix, iy, ik, & + & m, nrow, ncol, lldx, lldy, liwork, jx, jy, iiy, jjy,& + & ib, ip, idx + integer, parameter :: nb=4 + real(psb_dpk_), pointer :: iwork(:), xp(:), yp(:) + real(psb_dpk_), allocatable :: xvsave(:) + character :: trans_ + character(len=20) :: name, ch_err + logical :: aliw, doswap_ + integer :: debug_level, debug_unit + + name='psb_dspmv' + if (psb_errstatus_fatal()) return + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt=desc_a%get_context() + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(y%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + ia = 1 + ja = 1 + ix = 1 + jx = 1 + iy = 1 + jy = 1 + ik = 1 + ib = 1 + + if (present(doswap)) then + doswap_ = doswap + else + doswap_ = .true. + endif + + if (present(trans)) then + trans_ = psb_toupper(trans) + else + trans_ = 'N' + endif + if ( (trans_ == 'N').or.(trans_ == 'T')& + & .or.(trans_ == 'C')) then + else + info = psb_err_iarg_invalid_value_ + call psb_errpush(info,name) + goto 9999 + end if + + m = desc_a%get_global_rows() + n = desc_a%get_global_cols() + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + lldx = x%get_nrows() + lldy = y%get_nrows() + + iwork => null() + ! check for presence/size of a work area + liwork= 2*ncol + + if (present(work)) then + if (size(work) >= liwork) then + aliw =.false. + else + aliw=.true. + endif + else + aliw=.true. + end if + + if (aliw) then + allocate(iwork(liwork),stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='Allocate' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + else + iwork => work + endif + + if (debug_level >= psb_debug_comp_) & + & write(debug_unit,*) me,' ',trim(name),' Allocated work ', info + ! checking for matrix correctness + call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkmat' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if (debug_level >= psb_debug_comp_) & + & write(debug_unit,*) me,' ',trim(name),' Checkmat ', info + if (trans_ == 'N') then + ! Matrix is not transposed + if((ja /= ix).or.(ia /= iy)) then + ! this case is not yet implemented + info = psb_err_ja_nix_ia_niy_unsupported_ + call psb_errpush(info,name) + goto 9999 + end if + + ! checking for vectors correctness + call psb_chkvect(n,ik,x%get_nrows(),ix,jx,desc_a,info,iix,jjx) + if (info == psb_success_) & + & call psb_chkvect(m,ik,y%get_nrows(),iy,jy,desc_a,info,iiy,jjy) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if((iix /= 1).or.(iiy /= 1)) then + ! this case is not yet implemented + info = psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + goto 9999 + end if + + if (doswap_) then + call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),& + & dzero,x%v,desc_a,iwork,info,data=psb_comm_halo_) + end if + + call psb_csmm(alpha,a,x,beta,y,info) + + if(info /= psb_success_) then + info = psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + else + ! Matrix is transposed + if((ja /= iy).or.(ia /= ix)) then + ! this case is not yet implemented + info = psb_err_ja_nix_ia_niy_unsupported_ + call psb_errpush(info,name) + goto 9999 + end if + + ! checking for vectors correctness + call psb_chkvect(m,ik,x%get_nrows(),ix,jx,desc_a,info,iix,jjx) + if (info == psb_success_)& + & call psb_chkvect(n,ik,y%get_nrows(),iy,jy,desc_a,info,iiy,jjy) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if((iix /= 1).or.(iiy /= 1)) then + ! this case is not yet implemented + info = psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + goto 9999 + end if + + + ! + ! Non-empty overlap, need a buffer to hold + ! the entries updated with average operator. + ! Why the average? because in this way they will contribute + ! with a proper scale factor (1/np) to the overall product. + ! + call psi_ovrl_save(x%v,xvsave,desc_a,info) + if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,psb_avg_,info) +!!! THIS SHOULD BE FIXED !!! But beta is almost never /= 0 +!!$ yp(nrow+1:ncol) = dzero + + ! local Matrix-vector product + if (info == psb_success_) call psb_csmm(alpha,a,x,beta,y,info,trans=trans_) + + if (debug_level >= psb_debug_comp_) & + & write(debug_unit,*) me,' ',trim(name),' csmm ', info + + if (info == psb_success_) call psi_ovrl_restore(x%v,xvsave,desc_a,info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + ch_err='psb_csmm' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if (doswap_) then + call psi_swaptran(ior(psb_swap_send_,psb_swap_recv_),& + & done,y%v,desc_a,iwork,info) + if (info == psb_success_) call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),& + & done,y%v,desc_a,iwork,info,data=psb_comm_ovr_) + + if (debug_level >= psb_debug_comp_) & + & write(debug_unit,*) me,' ',trim(name),' swaptran ', info + if(info /= psb_success_) then + info = psb_err_from_subroutine_ + ch_err='PSI_dSwapTran' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + end if + + end if + + if (aliw) deallocate(iwork,stat=info) + if (debug_level >= psb_debug_comp_) & + & write(debug_unit,*) me,' ',trim(name),' deallocat ',aliw, info + if(info /= psb_success_) then + info = psb_err_from_subroutine_ + ch_err='Deallocate iwork' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + nullify(iwork) + + call psb_erractionrestore(err_act) + if (debug_level >= psb_debug_comp_) then + call psb_barrier(ictxt) + write(debug_unit,*) me,' ',trim(name),' Returning ' + endif + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return +end subroutine psb_dspmv_vect diff --git a/base/psblas/psb_dspnrm1.f90 b/base/psblas/psb_dspnrm1.f90 index cd5e46d55..6e8a81dc6 100644 --- a/base/psblas/psb_dspnrm1.f90 +++ b/base/psblas/psb_dspnrm1.f90 @@ -65,7 +65,7 @@ function psb_dspnrm1(a,desc_a,info) real(psb_dpk_), allocatable :: v(:) name='psb_dnrm1' - if(psb_get_errstatus() /= 0) return + if (psb_errstatus_fatal()) return info=psb_success_ call psb_erractionsave(err_act) diff --git a/base/psblas/psb_dspsm.f90 b/base/psblas/psb_dspsm.f90 index 5a986f950..96ac0a2f3 100644 --- a/base/psblas/psb_dspsm.f90 +++ b/base/psblas/psb_dspsm.f90 @@ -106,7 +106,7 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,& logical :: aliw name='psb_dspsm' - if(psb_get_errstatus() /= 0) return + if (psb_errstatus_fatal()) return info=psb_success_ call psb_erractionsave(err_act) @@ -384,7 +384,7 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,& logical :: aliw name='psb_dspsv' - if(psb_get_errstatus() /= 0) return + if (psb_errstatus_fatal()) return info=psb_success_ call psb_erractionsave(err_act) @@ -550,3 +550,208 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,& return end subroutine psb_dspsv +subroutine psb_dspsv_vect(alpha,a,x,beta,y,desc_a,info,& + & trans, scale, choice, diag, work) + use psb_base_mod, psb_protect_name => psb_dspsv_vect + use psi_mod + implicit none + + real(psb_dpk_), intent(in) :: alpha, beta + type(psb_d_vect_type), intent(inout) :: x + type(psb_d_vect_type), intent(inout) :: y + type(psb_dspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + type(psb_d_vect_type), intent(inout), optional :: diag + real(psb_dpk_), optional, target, intent(inout) :: work(:) + character, intent(in), optional :: trans, scale + integer, intent(in), optional :: choice + + ! locals + integer :: ictxt, np, me, & + & err_act, iix, jjx, ia, ja, iia, jja, lldx,lldy, choice_,& + & ix, iy, ik, jx, jy, i, lld,& + & m, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm + + character :: lscale + integer, parameter :: nb=4 + real(psb_dpk_),pointer :: iwork(:), xp(:), yp(:) + character :: itrans + character(len=20) :: name, ch_err + logical :: aliw + + name='psb_dspsv' + if (psb_errstatus_fatal()) return + info=psb_success_ + call psb_erractionsave(err_act) + + ictxt=desc_a%get_context() + + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(y%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + ! just this case right now + ia = 1 + ja = 1 + ix = 1 + iy = 1 + ik = 1 + jx = 1 + jy = 1 + + if (present(choice)) then + choice_ = choice + else + choice_ = psb_avg_ + endif + + if (present(scale)) then + lscale = psb_toupper(scale) + else + lscale = 'U' + endif + + if (present(trans)) then + itrans = psb_toupper(trans) + if((itrans == 'N').or.(itrans == 'T').or.(itrans == 'C')) then + ! Ok + else + info = psb_err_iarg_invalid_value_ + call psb_errpush(info,name) + goto 9999 + end if + else + itrans = 'N' + endif + + m = desc_a%get_global_rows() + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + lldx = x%get_nrows() + lldy = y%get_nrows() + + if((lldx < ncol).or.(lldy < ncol)) then + info=psb_err_lld_case_not_implemented_ + call psb_errpush(info,name) + goto 9999 + end if + + iwork => null() + ! check for presence/size of a work area + liwork= 2*ncol + + if (present(work)) then + if (size(work) >= liwork) then + aliw =.false. + else + aliw=.true. + endif + else + aliw=.true. + end if + + if (aliw) then + allocate(iwork(liwork),stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_realloc' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + else + iwork => work + endif + + iwork(1)=0.d0 + + ! checking for matrix correctness + call psb_chkmat(m,m,ia,ja,desc_a,info,iia,jja) + ! checking for vectors correctness + if (info == psb_success_) & + & call psb_chkvect(m,ik,x%get_nrows(),ix,jx,desc_a,info,iix,jjx) + if (info == psb_success_)& + & call psb_chkvect(m,ik,y%get_nrows(),iy,jy,desc_a,info,iiy,jjy) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect/mat' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if(ja /= ix) then + ! this case is not yet implemented + info = psb_err_ja_nix_ia_niy_unsupported_ + end if + + if((iix /= 1).or.(iiy /= 1)) then + ! this case is not yet implemented + info = psb_err_ix_n1_iy_n1_unsupported_ + end if + + if(info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + + ! Perform local triangular system solve +!!$ if (present(diag)) then +!!$ call psb_cssm(alpha,a,x,beta,y,info,scale=scale,d=diag,trans=trans) +!!$ else +!!$ call psb_cssm(alpha,a,x,beta,y,info,scale=scale,trans=trans) +!!$ end if + if (present(diag)) then + call a%cssm(alpha,x,beta,y,info,scale=scale,d=diag,trans=trans) + else + call a%cssm(alpha,x,beta,y,info,scale=scale,trans=trans) + end if + if(info /= psb_success_) then + info = psb_err_from_subroutine_ + ch_err='dcssm' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + ! update overlap elements + if (choice_ > 0) then + call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),& + & done,y%v,desc_a,iwork,info,data=psb_comm_ovr_) + + + if (info == psb_success_) call psi_ovrl_upd(y%v,desc_a,choice_,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='Inner updates') + goto 9999 + end if + end if + + if (aliw) deallocate(iwork) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return +end subroutine psb_dspsv_vect + diff --git a/base/psblas/psb_samax.f90 b/base/psblas/psb_samax.f90 index 1d57052e3..53b420fd6 100644 --- a/base/psblas/psb_samax.f90 +++ b/base/psblas/psb_samax.f90 @@ -254,6 +254,94 @@ function psb_samaxv (x,desc_a, info) return end function psb_samaxv + +function psb_samax_vect(x, desc_a, info) result(res) + use psb_penv_mod + use psb_serial_mod + use psb_descriptor_type + use psb_check_mod + use psb_error_mod + use psb_s_vect_mod + implicit none + + real(psb_spk_) :: res + type(psb_s_vect_type), intent (inout) :: x + type(psb_desc_type), intent (in) :: desc_a + integer, intent(out) :: info + + ! locals + integer :: ictxt, np, me,& + & err_act, iix, jjx, jx, ix, m, imax, isamax + real(psb_spk_) :: amax + character(len=20) :: name, ch_err + + name='psb_samaxv' + if(psb_get_errstatus() /= 0) return + info=psb_success_ + call psb_erractionsave(err_act) + + amax=0.d0 + ictxt=desc_a%get_context() + + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + ix = 1 + jx = 1 + + m = desc_a%get_global_rows() + + call psb_chkvect(m,1,x%get_nrows(),ix,jx,desc_a,info,iix,jjx) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if (iix /= 1) then + info=psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + goto 9999 + end if + + ! compute local max + if ((desc_a%get_local_rows() > 0).and.(m /= 0)) then + amax=x%amax(desc_a%get_local_rows()) + else + amax = szero + end if + + ! compute global max + call psb_amx(ictxt, amax) + + res=amax + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end function psb_samax_vect + + !!$ !!$ Parallel Sparse BLAS version 3.0 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 diff --git a/base/psblas/psb_sasum.f90 b/base/psblas/psb_sasum.f90 index 0b75f1eb5..23d1310be 100644 --- a/base/psblas/psb_sasum.f90 +++ b/base/psblas/psb_sasum.f90 @@ -282,6 +282,96 @@ function psb_sasumv (x,desc_a, info) end function psb_sasumv +function psb_sasum_vect(x, desc_a, info) result(res) + use psb_penv_mod + use psb_serial_mod + use psb_descriptor_type + use psb_check_mod + use psb_error_mod + use psb_s_vect_mod + implicit none + + real(psb_spk_) :: res + type(psb_s_vect_type), intent (inout) :: x + type(psb_desc_type), intent (in) :: desc_a + integer, intent(out) :: info + + ! locals + integer :: ictxt, np, me,& + & err_act, iix, jjx, jx, ix, m, imax + real(psb_spk_) :: asum + character(len=20) :: name, ch_err + + name='psb_sasumv' + if (psb_errstatus_fatal()) return + info=psb_success_ + call psb_erractionsave(err_act) + + asum=0.d0 + + ictxt=desc_a%get_context() + + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + ix = 1 + jx = 1 + + m = desc_a%get_global_rows() + + call psb_chkvect(m,1,x%get_nrows(),ix,jx,desc_a,info,iix,jjx) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if (iix /= 1) then + info=psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + goto 9999 + end if + + ! compute local max + if ((desc_a%get_local_rows() > 0).and.(m /= 0)) then + asum=x%asum(desc_a%get_local_rows()) + else + asum = szero + end if + + ! compute global sum + call psb_sum(ictxt, asum) + + res=asum + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end function psb_sasum_vect + + + !!$ !!$ Parallel Sparse BLAS version 3.0 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 diff --git a/base/psblas/psb_saxpby.f90 b/base/psblas/psb_saxpby.f90 index c60319f08..0837cbcfc 100644 --- a/base/psblas/psb_saxpby.f90 +++ b/base/psblas/psb_saxpby.f90 @@ -30,6 +30,91 @@ !!$ !!$ ! File: psb_saxpby.f90 + +subroutine psb_saxpby_vect(alpha, x, beta, y,& + & desc_a, info) + use psb_base_mod, psb_protect_name => psb_saxpby_vect + implicit none + type(psb_s_vect_type), intent (inout) :: x + type(psb_s_vect_type), intent (inout) :: y + real(psb_spk_), intent (in) :: alpha, beta + type(psb_desc_type), intent (in) :: desc_a + integer, intent(out) :: info + + ! locals + integer :: ictxt, np, me,& + & err_act, iix, jjx, ix, iy, m, iiy, jjy + character(len=20) :: name, ch_err + + name='psb_sgeaxpby' + if (psb_errstatus_fatal()) return + info=psb_success_ + call psb_erractionsave(err_act) + + ictxt=desc_a%get_context() + + call psb_info(ictxt, me, np) + if (np == -ione) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(y%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + ix = ione + iy = ione + + m = desc_a%get_global_rows() + + ! check vector correctness + call psb_chkvect(m,ione,x%get_nrows(),ix,ione,desc_a,info,iix,jjx) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect 1' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + call psb_chkvect(m,ione,y%get_nrows(),iy,ione,desc_a,info,iiy,jjy) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect 2' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if ((iix /= ione).or.(iiy /= ione)) then + info=psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + end if + + if(desc_a%get_local_rows() > 0) then + call y%axpby(desc_a%get_local_rows(),& + & alpha,x,beta,info) + 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(ictxt) + return + end if + return + +end subroutine psb_saxpby_vect ! ! Subroutine: psb_saxpby ! Adds one distributed matrix to another, diff --git a/base/psblas/psb_sdot.f90 b/base/psblas/psb_sdot.f90 index 4089d3f1c..268f91cd9 100644 --- a/base/psblas/psb_sdot.f90 +++ b/base/psblas/psb_sdot.f90 @@ -48,6 +48,113 @@ ! jx - integer(optional). The column offset for sub( X ). ! jy - integer(optional). The column offset for sub( Y ). ! +function psb_sdot_vect(x, y, desc_a,info) result(res) + use psb_descriptor_type + use psb_s_base_mat_mod + use psb_check_mod + use psb_error_mod + use psb_penv_mod + use psb_s_vect_mod + use psb_s_psblas_mod, psb_protect_name => psb_sdot_vect + implicit none + real(psb_spk_) :: res + type(psb_s_vect_type), intent(inout) :: x, y + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + + ! locals + integer :: ictxt, np, me, idx, ndm,& + & err_act, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, nr + real(psb_spk_) :: dot_local + real(psb_spk_) :: sdot + character(len=20) :: name, ch_err + + name='psb_sdot' + res = szero + if (psb_errstatus_fatal()) return + info=psb_success_ + call psb_erractionsave(err_act) + + ictxt=desc_a%get_context() + call psb_info(ictxt, me, np) + if (np == -ione) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(y%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + ix = ione + ijx = ione + + iy = ione + ijy = ione + + m = desc_a%get_global_rows() + + ! check vector correctness + call psb_chkvect(m,ione,x%get_nrows(),ix,ijx,desc_a,info,iix,jjx) + if (info == psb_success_) & + & call psb_chkvect(m,ione,y%get_nrows(),iy,ijy,desc_a,info,iiy,jjy) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if ((iix /= ione).or.(iiy /= ione)) then + info=psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + goto 9999 + end if + + if(m /= 0) then + nr = desc_a%get_local_rows() + if(nr > 0) then + dot_local = x%dot(nr,y) +!!$ ! adjust dot_local because overlapped elements are computed more than once +!!$ do i=1,size(desc_a%ovrlap_elem,1) +!!$ idx = desc_a%ovrlap_elem(i,1) +!!$ ndm = desc_a%ovrlap_elem(i,2) +!!$ dot_local = dot_local - (real(ndm-1)/real(ndm))*(x(idx)*y(idx)) +!!$ end do + else + dot_local=szero + end if + else + dot_local=szero + end if + + ! compute global sum + call psb_sum(ictxt, dot_local) + + res = dot_local + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end function psb_sdot_vect + function psb_sdot(x, y,desc_a, info, jx, jy) use psb_descriptor_type use psb_check_mod diff --git a/base/psblas/psb_snrm2.f90 b/base/psblas/psb_snrm2.f90 index 511074c84..74c3a0821 100644 --- a/base/psblas/psb_snrm2.f90 +++ b/base/psblas/psb_snrm2.f90 @@ -267,6 +267,101 @@ function psb_snrm2v(x, desc_a, info) end function psb_snrm2v +function psb_snrm2_vect(x, desc_a, info) result(res) + use psb_descriptor_type + use psb_check_mod + use psb_error_mod + use psb_penv_mod + use psb_s_vect_mod + implicit none + + real(psb_spk_) :: res + type(psb_s_vect_type), intent (inout) :: x + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + + ! locals + integer :: ictxt, np, me,& + & err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm + real(psb_spk_) :: nrm2, snrm2, dd +!!$ external dcombnrm2 + character(len=20) :: name, ch_err + + name='psb_snrm2v' + if (psb_errstatus_fatal()) return + info=psb_success_ + call psb_erractionsave(err_act) + + ictxt=desc_a%get_context() + + call psb_info(ictxt, me, np) + if (np == -1) then + info=psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + ix = 1 + jx=1 + m = desc_a%get_global_rows() + + call psb_chkvect(m,1,x%get_nrows(),ix,jx,desc_a,info,iix,jjx) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect' + call psb_errpush(info,name,a_err=ch_err) + end if + + if (iix /= 1) then + info=psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + goto 9999 + end if + + if(m /= 0) then + if (desc_a%get_local_rows() > 0) then + ndim = desc_a%get_local_rows() + nrm2 = x%nrm2(ndim) +!!$ ! adjust because overlapped elements are computed more than once +!!$ do i=1,size(desc_a%ovrlap_elem,1) +!!$ idx = desc_a%ovrlap_elem(i,1) +!!$ ndm = desc_a%ovrlap_elem(i,2) +!!$ dd = dble(ndm-1)/dble(ndm) +!!$ nrm2 = nrm2 * sqrt(done - dd*(abs(x(idx))/nrm2)**2) +!!$ end do + else + nrm2 = szero + end if + else + nrm2 = szero + end if + +!!$ call pdtreecomb(ictxt,'All',1,nrm2,-1,-1,dcombnrm2) + call psb_nrm2(ictxt,nrm2) + + res = nrm2 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return +end function psb_snrm2_vect + + !!$ diff --git a/base/psblas/psb_sspmm.f90 b/base/psblas/psb_sspmm.f90 index 662389ac8..05f34a287 100644 --- a/base/psblas/psb_sspmm.f90 +++ b/base/psblas/psb_sspmm.f90 @@ -672,3 +672,274 @@ subroutine psb_sspmv(alpha,a,x,beta,y,desc_a,info,& end if return end subroutine psb_sspmv + + +subroutine psb_sspmv_vect(alpha,a,x,beta,y,desc_a,info,& + & trans, work, doswap) + use psb_base_mod, psb_protect_name => psb_sspmv_vect + use psi_mod + implicit none + + real(psb_spk_), intent(in) :: alpha, beta + type(psb_s_vect_type), intent(inout) :: x + type(psb_s_vect_type), intent(inout) :: y + type(psb_sspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + real(psb_spk_), optional, target, intent(inout) :: work(:) + character, intent(in), optional :: trans + logical, intent(in), optional :: doswap + + ! locals + integer :: ictxt, np, me,& + & err_act, n, iix, jjx, ia, ja, iia, jja, ix, iy, ik, & + & m, nrow, ncol, lldx, lldy, liwork, jx, jy, iiy, jjy,& + & ib, ip, idx + integer, parameter :: nb=4 + real(psb_spk_), pointer :: iwork(:), xp(:), yp(:) + real(psb_spk_), allocatable :: xvsave(:) + character :: trans_ + character(len=20) :: name, ch_err + logical :: aliw, doswap_ + integer :: debug_level, debug_unit + + name='psb_sspmv' + if (psb_errstatus_fatal()) return + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt=desc_a%get_context() + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(y%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + ia = 1 + ja = 1 + ix = 1 + jx = 1 + iy = 1 + jy = 1 + ik = 1 + ib = 1 + + if (present(doswap)) then + doswap_ = doswap + else + doswap_ = .true. + endif + + if (present(trans)) then + trans_ = psb_toupper(trans) + else + trans_ = 'N' + endif + if ( (trans_ == 'N').or.(trans_ == 'T')& + & .or.(trans_ == 'C')) then + else + info = psb_err_iarg_invalid_value_ + call psb_errpush(info,name) + goto 9999 + end if + + m = desc_a%get_global_rows() + n = desc_a%get_global_cols() + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + lldx = x%get_nrows() + lldy = y%get_nrows() + + iwork => null() + ! check for presence/size of a work area + liwork= 2*ncol + + if (present(work)) then + if (size(work) >= liwork) then + aliw =.false. + else + aliw=.true. + endif + else + aliw=.true. + end if + + if (aliw) then + allocate(iwork(liwork),stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='Allocate' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + else + iwork => work + endif + + if (debug_level >= psb_debug_comp_) & + & write(debug_unit,*) me,' ',trim(name),' Allocated work ', info + ! checking for matrix correctness + call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkmat' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if (debug_level >= psb_debug_comp_) & + & write(debug_unit,*) me,' ',trim(name),' Checkmat ', info + if (trans_ == 'N') then + ! Matrix is not transposed + if((ja /= ix).or.(ia /= iy)) then + ! this case is not yet implemented + info = psb_err_ja_nix_ia_niy_unsupported_ + call psb_errpush(info,name) + goto 9999 + end if + + ! checking for vectors correctness + call psb_chkvect(n,ik,x%get_nrows(),ix,jx,desc_a,info,iix,jjx) + if (info == psb_success_) & + & call psb_chkvect(m,ik,y%get_nrows(),iy,jy,desc_a,info,iiy,jjy) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if((iix /= 1).or.(iiy /= 1)) then + ! this case is not yet implemented + info = psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + goto 9999 + end if + + if (doswap_) then + call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),& + & szero,x%v,desc_a,iwork,info,data=psb_comm_halo_) + end if + + call psb_csmm(alpha,a,x,beta,y,info) + + if(info /= psb_success_) then + info = psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + else + ! Matrix is transposed + if((ja /= iy).or.(ia /= ix)) then + ! this case is not yet implemented + info = psb_err_ja_nix_ia_niy_unsupported_ + call psb_errpush(info,name) + goto 9999 + end if + + ! checking for vectors correctness + call psb_chkvect(m,ik,x%get_nrows(),ix,jx,desc_a,info,iix,jjx) + if (info == psb_success_)& + & call psb_chkvect(n,ik,y%get_nrows(),iy,jy,desc_a,info,iiy,jjy) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if((iix /= 1).or.(iiy /= 1)) then + ! this case is not yet implemented + info = psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + goto 9999 + end if + + + ! + ! Non-empty overlap, need a buffer to hold + ! the entries updated with average operator. + ! Why the average? because in this way they will contribute + ! with a proper scale factor (1/np) to the overall product. + ! + call psi_ovrl_save(x%v,xvsave,desc_a,info) + if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,psb_avg_,info) +!!! THIS SHOULD BE FIXED !!! But beta is almost never /= 0 +!!$ yp(nrow+1:ncol) = szero + + ! local Matrix-vector product + if (info == psb_success_) call psb_csmm(alpha,a,x,beta,y,info,trans=trans_) + + if (debug_level >= psb_debug_comp_) & + & write(debug_unit,*) me,' ',trim(name),' csmm ', info + + if (info == psb_success_) call psi_ovrl_restore(x%v,xvsave,desc_a,info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + ch_err='psb_csmm' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if (doswap_) then + call psi_swaptran(ior(psb_swap_send_,psb_swap_recv_),& + & sone,y%v,desc_a,iwork,info) + if (info == psb_success_) call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),& + & sone,y%v,desc_a,iwork,info,data=psb_comm_ovr_) + + if (debug_level >= psb_debug_comp_) & + & write(debug_unit,*) me,' ',trim(name),' swaptran ', info + if(info /= psb_success_) then + info = psb_err_from_subroutine_ + ch_err='PSI_dSwapTran' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + end if + + end if + + if (aliw) deallocate(iwork,stat=info) + if (debug_level >= psb_debug_comp_) & + & write(debug_unit,*) me,' ',trim(name),' deallocat ',aliw, info + if(info /= psb_success_) then + info = psb_err_from_subroutine_ + ch_err='Deallocate iwork' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + nullify(iwork) + + call psb_erractionrestore(err_act) + if (debug_level >= psb_debug_comp_) then + call psb_barrier(ictxt) + write(debug_unit,*) me,' ',trim(name),' Returning ' + endif + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return +end subroutine psb_sspmv_vect diff --git a/base/psblas/psb_sspsm.f90 b/base/psblas/psb_sspsm.f90 index bb729e2bb..85e9d2425 100644 --- a/base/psblas/psb_sspsm.f90 +++ b/base/psblas/psb_sspsm.f90 @@ -550,3 +550,204 @@ subroutine psb_sspsv(alpha,a,x,beta,y,desc_a,info,& return end subroutine psb_sspsv +subroutine psb_sspsv_vect(alpha,a,x,beta,y,desc_a,info,& + & trans, scale, choice, diag, work) + use psb_base_mod, psb_protect_name => psb_sspsv_vect + use psi_mod + implicit none + + real(psb_spk_), intent(in) :: alpha, beta + type(psb_s_vect_type), intent(inout) :: x + type(psb_s_vect_type), intent(inout) :: y + type(psb_sspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + type(psb_s_vect_type), intent(inout), optional :: diag + real(psb_spk_), optional, target, intent(inout) :: work(:) + character, intent(in), optional :: trans, scale + integer, intent(in), optional :: choice + + ! locals + integer :: ictxt, np, me, & + & err_act, iix, jjx, ia, ja, iia, jja, lldx,lldy, choice_,& + & ix, iy, ik, jx, jy, i, lld,& + & m, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm + + character :: lscale + integer, parameter :: nb=4 + real(psb_spk_),pointer :: iwork(:), xp(:), yp(:) + character :: itrans + character(len=20) :: name, ch_err + logical :: aliw + + name='psb_sspsv' + if (psb_errstatus_fatal()) return + info=psb_success_ + call psb_erractionsave(err_act) + + ictxt=desc_a%get_context() + + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(y%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + ! just this case right now + ia = 1 + ja = 1 + ix = 1 + iy = 1 + ik = 1 + jx = 1 + jy = 1 + + if (present(choice)) then + choice_ = choice + else + choice_ = psb_avg_ + endif + + if (present(scale)) then + lscale = psb_toupper(scale) + else + lscale = 'U' + endif + + if (present(trans)) then + itrans = psb_toupper(trans) + if((itrans == 'N').or.(itrans == 'T').or.(itrans == 'C')) then + ! Ok + else + info = psb_err_iarg_invalid_value_ + call psb_errpush(info,name) + goto 9999 + end if + else + itrans = 'N' + endif + + m = desc_a%get_global_rows() + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + lldx = x%get_nrows() + lldy = y%get_nrows() + + if((lldx < ncol).or.(lldy < ncol)) then + info=psb_err_lld_case_not_implemented_ + call psb_errpush(info,name) + goto 9999 + end if + + iwork => null() + ! check for presence/size of a work area + liwork= 2*ncol + + if (present(work)) then + if (size(work) >= liwork) then + aliw =.false. + else + aliw=.true. + endif + else + aliw=.true. + end if + + if (aliw) then + allocate(iwork(liwork),stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_realloc' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + else + iwork => work + endif + + iwork(1)=0.d0 + + ! checking for matrix correctness + call psb_chkmat(m,m,ia,ja,desc_a,info,iia,jja) + ! checking for vectors correctness + if (info == psb_success_) & + & call psb_chkvect(m,ik,x%get_nrows(),ix,jx,desc_a,info,iix,jjx) + if (info == psb_success_)& + & call psb_chkvect(m,ik,y%get_nrows(),iy,jy,desc_a,info,iiy,jjy) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect/mat' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if(ja /= ix) then + ! this case is not yet implemented + info = psb_err_ja_nix_ia_niy_unsupported_ + end if + + if((iix /= 1).or.(iiy /= 1)) then + ! this case is not yet implemented + info = psb_err_ix_n1_iy_n1_unsupported_ + end if + + if(info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + + ! Perform local triangular system solve + if (present(diag)) then + call a%cssm(alpha,x,beta,y,info,scale=scale,d=diag,trans=trans) + else + call a%cssm(alpha,x,beta,y,info,scale=scale,trans=trans) + end if + if(info /= psb_success_) then + info = psb_err_from_subroutine_ + ch_err='dcssm' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + ! update overlap elements + if (choice_ > 0) then + call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),& + & sone,y%v,desc_a,iwork,info,data=psb_comm_ovr_) + + + if (info == psb_success_) call psi_ovrl_upd(y%v,desc_a,choice_,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='Inner updates') + goto 9999 + end if + end if + + if (aliw) deallocate(iwork) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return +end subroutine psb_sspsv_vect + + diff --git a/base/psblas/psb_zamax.f90 b/base/psblas/psb_zamax.f90 index a9e15312b..466792e2e 100644 --- a/base/psblas/psb_zamax.f90 +++ b/base/psblas/psb_zamax.f90 @@ -133,6 +133,93 @@ function psb_zamax (x,desc_a, info, jx) end function psb_zamax +function psb_zamax_vect(x, desc_a, info) result(res) + use psb_penv_mod + use psb_serial_mod + use psb_descriptor_type + use psb_check_mod + use psb_error_mod + use psb_z_vect_mod + implicit none + + real(psb_dpk_) :: res + type(psb_z_vect_type), intent (inout) :: x + type(psb_desc_type), intent (in) :: desc_a + integer, intent(out) :: info + + ! locals + integer :: ictxt, np, me,& + & err_act, iix, jjx, jx, ix, m, imax, isamax + real(psb_dpk_) :: amax + character(len=20) :: name, ch_err + + name='psb_zamaxv' + if(psb_get_errstatus() /= 0) return + info=psb_success_ + call psb_erractionsave(err_act) + + amax=dzero + ictxt=desc_a%get_context() + + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + ix = 1 + jx = 1 + + m = desc_a%get_global_rows() + + call psb_chkvect(m,1,x%get_nrows(),ix,jx,desc_a,info,iix,jjx) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if (iix /= 1) then + info=psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + goto 9999 + end if + + ! compute local max + if ((desc_a%get_local_rows() > 0).and.(m /= 0)) then + amax=x%amax(desc_a%get_local_rows()) + else + amax = dzero + end if + + ! compute global max + call psb_amx(ictxt, amax) + + res=amax + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end function psb_zamax_vect + + !!$ diff --git a/base/psblas/psb_zasum.f90 b/base/psblas/psb_zasum.f90 index ce9f4ae36..ff8986d08 100644 --- a/base/psblas/psb_zasum.f90 +++ b/base/psblas/psb_zasum.f90 @@ -121,14 +121,12 @@ function psb_zasum (x,desc_a, info, jx) asum = asum - (real(ndm-1)/real(ndm))*cabs1(x(idx,jjx)) end do - ! compute global sum - call psb_sum(ictxt, asum) else asum=0.d0 - ! compute global sum - call psb_sum(ictxt, asum) end if + ! compute global sum + call psb_sum(ictxt, asum) else asum=0.d0 end if @@ -150,6 +148,96 @@ function psb_zasum (x,desc_a, info, jx) end function psb_zasum +function psb_zasum_vect(x, desc_a, info) result(res) + use psb_penv_mod + use psb_serial_mod + use psb_descriptor_type + use psb_check_mod + use psb_error_mod + use psb_z_vect_mod + implicit none + + real(psb_dpk_) :: res + type(psb_z_vect_type), intent (inout) :: x + type(psb_desc_type), intent (in) :: desc_a + integer, intent(out) :: info + + ! locals + integer :: ictxt, np, me,& + & err_act, iix, jjx, jx, ix, m, imax + real(psb_dpk_) :: asum + character(len=20) :: name, ch_err + + name='psb_zasumv' + if (psb_errstatus_fatal()) return + info=psb_success_ + call psb_erractionsave(err_act) + + asum=0.d0 + + ictxt=desc_a%get_context() + + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + ix = 1 + jx = 1 + + m = desc_a%get_global_rows() + + call psb_chkvect(m,1,x%get_nrows(),ix,jx,desc_a,info,iix,jjx) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if (iix /= 1) then + info=psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + goto 9999 + end if + + ! compute local max + if ((desc_a%get_local_rows() > 0).and.(m /= 0)) then + asum=x%asum(desc_a%get_local_rows()) + else + asum = dzero + end if + + ! compute global sum + call psb_sum(ictxt, asum) + + res=asum + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end function psb_zasum_vect + + + !!$ !!$ Parallel Sparse BLAS version 3.0 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 diff --git a/base/psblas/psb_zaxpby.f90 b/base/psblas/psb_zaxpby.f90 index b8f844ae8..6973e7689 100644 --- a/base/psblas/psb_zaxpby.f90 +++ b/base/psblas/psb_zaxpby.f90 @@ -30,6 +30,92 @@ !!$ !!$ ! File: psb_zaxpby.f90 + +subroutine psb_zaxpby_vect(alpha, x, beta, y,& + & desc_a, info) + use psb_base_mod, psb_protect_name => psb_zaxpby_vect + implicit none + type(psb_z_vect_type), intent (inout) :: x + type(psb_z_vect_type), intent (inout) :: y + complex(psb_dpk_), intent (in) :: alpha, beta + type(psb_desc_type), intent (in) :: desc_a + integer, intent(out) :: info + + ! locals + integer :: ictxt, np, me,& + & err_act, iix, jjx, ix, iy, m, iiy, jjy + character(len=20) :: name, ch_err + + name='psb_zgeaxpby' + if (psb_errstatus_fatal()) return + info=psb_success_ + call psb_erractionsave(err_act) + + ictxt=desc_a%get_context() + + call psb_info(ictxt, me, np) + if (np == -ione) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(y%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + ix = ione + iy = ione + + m = desc_a%get_global_rows() + + ! check vector correctness + call psb_chkvect(m,ione,x%get_nrows(),ix,ione,desc_a,info,iix,jjx) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect 1' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + call psb_chkvect(m,ione,y%get_nrows(),iy,ione,desc_a,info,iiy,jjy) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect 2' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if ((iix /= ione).or.(iiy /= ione)) then + info=psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + end if + + if(desc_a%get_local_rows() > 0) then + call y%axpby(desc_a%get_local_rows(),& + & alpha,x,beta,info) + 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(ictxt) + return + end if + return + +end subroutine psb_zaxpby_vect + ! ! Subroutine: psb_zaxpby ! Adds one distributed matrix to another, diff --git a/base/psblas/psb_zdot.f90 b/base/psblas/psb_zdot.f90 index 603a24227..d1b28a865 100644 --- a/base/psblas/psb_zdot.f90 +++ b/base/psblas/psb_zdot.f90 @@ -48,6 +48,112 @@ ! jx - integer(optional). The column offset for sub( X ). ! jy - integer(optional). The column offset for sub( Y ). ! +function psb_zdot_vect(x, y, desc_a,info) result(res) + use psb_descriptor_type + use psb_z_base_mat_mod + use psb_check_mod + use psb_error_mod + use psb_penv_mod + use psb_z_vect_mod + use psb_z_psblas_mod, psb_protect_name => psb_zdot_vect + implicit none + complex(psb_dpk_) :: res + type(psb_z_vect_type), intent(inout) :: x, y + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + + ! locals + integer :: ictxt, np, me, idx, ndm,& + & err_act, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, nr + complex(psb_dpk_) :: dot_local + character(len=20) :: name, ch_err + + name='psb_sdot' + res = szero + if (psb_errstatus_fatal()) return + info=psb_success_ + call psb_erractionsave(err_act) + + ictxt=desc_a%get_context() + call psb_info(ictxt, me, np) + if (np == -ione) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(y%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + ix = ione + ijx = ione + + iy = ione + ijy = ione + + m = desc_a%get_global_rows() + + ! check vector correctness + call psb_chkvect(m,ione,x%get_nrows(),ix,ijx,desc_a,info,iix,jjx) + if (info == psb_success_) & + & call psb_chkvect(m,ione,y%get_nrows(),iy,ijy,desc_a,info,iiy,jjy) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if ((iix /= ione).or.(iiy /= ione)) then + info=psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + goto 9999 + end if + + if(m /= 0) then + nr = desc_a%get_local_rows() + if(nr > 0) then + dot_local = x%dot(nr,y) +!!$ ! adjust dot_local because overlapped elements are computed more than once +!!$ do i=1,size(desc_a%ovrlap_elem,1) +!!$ idx = desc_a%ovrlap_elem(i,1) +!!$ ndm = desc_a%ovrlap_elem(i,2) +!!$ dot_local = dot_local - (real(ndm-1)/real(ndm))*(x(idx)*y(idx)) +!!$ end do + else + dot_local=zzero + end if + else + dot_local=zzero + end if + + ! compute global sum + call psb_sum(ictxt, dot_local) + + res = dot_local + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end function psb_zdot_vect + function psb_zdot(x, y,desc_a, info, jx, jy) use psb_descriptor_type use psb_check_mod diff --git a/base/psblas/psb_znrm2.f90 b/base/psblas/psb_znrm2.f90 index d67e4ce36..9eba9484d 100644 --- a/base/psblas/psb_znrm2.f90 +++ b/base/psblas/psb_znrm2.f90 @@ -269,6 +269,99 @@ function psb_znrm2v(x, desc_a, info) end function psb_znrm2v +function psb_znrm2_vect(x, desc_a, info) result(res) + use psb_descriptor_type + use psb_check_mod + use psb_error_mod + use psb_penv_mod + use psb_z_vect_mod + implicit none + + real(psb_dpk_) :: res + type(psb_z_vect_type), intent (inout) :: x + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + + ! locals + integer :: ictxt, np, me,& + & err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm + real(psb_dpk_) :: nrm2 + character(len=20) :: name, ch_err + + name='psb_znrm2v' + if (psb_errstatus_fatal()) return + info=psb_success_ + call psb_erractionsave(err_act) + + ictxt=desc_a%get_context() + + call psb_info(ictxt, me, np) + if (np == -1) then + info=psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + ix = 1 + jx=1 + m = desc_a%get_global_rows() + + call psb_chkvect(m,1,x%get_nrows(),ix,jx,desc_a,info,iix,jjx) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect' + call psb_errpush(info,name,a_err=ch_err) + end if + + if (iix /= 1) then + info=psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + goto 9999 + end if + + if(m /= 0) then + if (desc_a%get_local_rows() > 0) then + ndim = desc_a%get_local_rows() + nrm2 = x%nrm2(ndim) +!!$ ! adjust because overlapped elements are computed more than once +!!$ do i=1,size(desc_a%ovrlap_elem,1) +!!$ idx = desc_a%ovrlap_elem(i,1) +!!$ ndm = desc_a%ovrlap_elem(i,2) +!!$ dd = dble(ndm-1)/dble(ndm) +!!$ nrm2 = nrm2 * sqrt(done - dd*(abs(x(idx))/nrm2)**2) +!!$ end do + else + nrm2 = dzero + end if + else + nrm2 = dzero + end if + + call psb_nrm2(ictxt,nrm2) + + res = nrm2 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return +end function psb_znrm2_vect + + !!$ diff --git a/base/psblas/psb_zspmm.f90 b/base/psblas/psb_zspmm.f90 index 1437ca0c8..f1c818cc2 100644 --- a/base/psblas/psb_zspmm.f90 +++ b/base/psblas/psb_zspmm.f90 @@ -672,3 +672,274 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,& end if return end subroutine psb_zspmv + + +subroutine psb_zspmv_vect(alpha,a,x,beta,y,desc_a,info,& + & trans, work, doswap) + use psb_base_mod, psb_protect_name => psb_zspmv_vect + use psi_mod + implicit none + + complex(psb_dpk_), intent(in) :: alpha, beta + type(psb_z_vect_type), intent(inout) :: x + type(psb_z_vect_type), intent(inout) :: y + type(psb_zspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + complex(psb_dpk_), optional, target, intent(inout) :: work(:) + character, intent(in), optional :: trans + logical, intent(in), optional :: doswap + + ! locals + integer :: ictxt, np, me,& + & err_act, n, iix, jjx, ia, ja, iia, jja, ix, iy, ik, & + & m, nrow, ncol, lldx, lldy, liwork, jx, jy, iiy, jjy,& + & ib, ip, idx + integer, parameter :: nb=4 + complex(psb_dpk_), pointer :: iwork(:), xp(:), yp(:) + complex(psb_dpk_), allocatable :: xvsave(:) + character :: trans_ + character(len=20) :: name, ch_err + logical :: aliw, doswap_ + integer :: debug_level, debug_unit + + name='psb_zspmv' + if (psb_errstatus_fatal()) return + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt=desc_a%get_context() + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(y%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + ia = 1 + ja = 1 + ix = 1 + jx = 1 + iy = 1 + jy = 1 + ik = 1 + ib = 1 + + if (present(doswap)) then + doswap_ = doswap + else + doswap_ = .true. + endif + + if (present(trans)) then + trans_ = psb_toupper(trans) + else + trans_ = 'N' + endif + if ( (trans_ == 'N').or.(trans_ == 'T')& + & .or.(trans_ == 'C')) then + else + info = psb_err_iarg_invalid_value_ + call psb_errpush(info,name) + goto 9999 + end if + + m = desc_a%get_global_rows() + n = desc_a%get_global_cols() + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + lldx = x%get_nrows() + lldy = y%get_nrows() + + iwork => null() + ! check for presence/size of a work area + liwork= 2*ncol + + if (present(work)) then + if (size(work) >= liwork) then + aliw =.false. + else + aliw=.true. + endif + else + aliw=.true. + end if + + if (aliw) then + allocate(iwork(liwork),stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='Allocate' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + else + iwork => work + endif + + if (debug_level >= psb_debug_comp_) & + & write(debug_unit,*) me,' ',trim(name),' Allocated work ', info + ! checking for matrix correctness + call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkmat' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if (debug_level >= psb_debug_comp_) & + & write(debug_unit,*) me,' ',trim(name),' Checkmat ', info + if (trans_ == 'N') then + ! Matrix is not transposed + if((ja /= ix).or.(ia /= iy)) then + ! this case is not yet implemented + info = psb_err_ja_nix_ia_niy_unsupported_ + call psb_errpush(info,name) + goto 9999 + end if + + ! checking for vectors correctness + call psb_chkvect(n,ik,x%get_nrows(),ix,jx,desc_a,info,iix,jjx) + if (info == psb_success_) & + & call psb_chkvect(m,ik,y%get_nrows(),iy,jy,desc_a,info,iiy,jjy) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if((iix /= 1).or.(iiy /= 1)) then + ! this case is not yet implemented + info = psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + goto 9999 + end if + + if (doswap_) then + call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),& + & zzero,x%v,desc_a,iwork,info,data=psb_comm_halo_) + end if + + call psb_csmm(alpha,a,x,beta,y,info) + + if(info /= psb_success_) then + info = psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + else + ! Matrix is transposed + if((ja /= iy).or.(ia /= ix)) then + ! this case is not yet implemented + info = psb_err_ja_nix_ia_niy_unsupported_ + call psb_errpush(info,name) + goto 9999 + end if + + ! checking for vectors correctness + call psb_chkvect(m,ik,x%get_nrows(),ix,jx,desc_a,info,iix,jjx) + if (info == psb_success_)& + & call psb_chkvect(n,ik,y%get_nrows(),iy,jy,desc_a,info,iiy,jjy) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if((iix /= 1).or.(iiy /= 1)) then + ! this case is not yet implemented + info = psb_err_ix_n1_iy_n1_unsupported_ + call psb_errpush(info,name) + goto 9999 + end if + + + ! + ! Non-empty overlap, need a buffer to hold + ! the entries updated with average operator. + ! Why the average? because in this way they will contribute + ! with a proper scale factor (1/np) to the overall product. + ! + call psi_ovrl_save(x%v,xvsave,desc_a,info) + if (info == psb_success_) call psi_ovrl_upd(x%v,desc_a,psb_avg_,info) +!!! THIS SHOULD BE FIXED !!! But beta is almost never /= 0 +!!$ yp(nrow+1:ncol) = szero + + ! local Matrix-vector product + if (info == psb_success_) call psb_csmm(alpha,a,x,beta,y,info,trans=trans_) + + if (debug_level >= psb_debug_comp_) & + & write(debug_unit,*) me,' ',trim(name),' csmm ', info + + if (info == psb_success_) call psi_ovrl_restore(x%v,xvsave,desc_a,info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + ch_err='psb_csmm' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if (doswap_) then + call psi_swaptran(ior(psb_swap_send_,psb_swap_recv_),& + & zone,y%v,desc_a,iwork,info) + if (info == psb_success_) call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),& + & zone,y%v,desc_a,iwork,info,data=psb_comm_ovr_) + + if (debug_level >= psb_debug_comp_) & + & write(debug_unit,*) me,' ',trim(name),' swaptran ', info + if(info /= psb_success_) then + info = psb_err_from_subroutine_ + ch_err='PSI_SwapTran' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + end if + + end if + + if (aliw) deallocate(iwork,stat=info) + if (debug_level >= psb_debug_comp_) & + & write(debug_unit,*) me,' ',trim(name),' deallocat ',aliw, info + if(info /= psb_success_) then + info = psb_err_from_subroutine_ + ch_err='Deallocate iwork' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + nullify(iwork) + + call psb_erractionrestore(err_act) + if (debug_level >= psb_debug_comp_) then + call psb_barrier(ictxt) + write(debug_unit,*) me,' ',trim(name),' Returning ' + endif + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return +end subroutine psb_zspmv_vect diff --git a/base/psblas/psb_zspsm.f90 b/base/psblas/psb_zspsm.f90 index 0990ee10e..4e0b209a9 100644 --- a/base/psblas/psb_zspsm.f90 +++ b/base/psblas/psb_zspsm.f90 @@ -549,3 +549,204 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,& return end subroutine psb_zspsv + +subroutine psb_zspsv_vect(alpha,a,x,beta,y,desc_a,info,& + & trans, scale, choice, diag, work) + use psb_base_mod, psb_protect_name => psb_zspsv_vect + use psi_mod + implicit none + + complex(psb_dpk_), intent(in) :: alpha, beta + type(psb_z_vect_type), intent(inout) :: x + type(psb_z_vect_type), intent(inout) :: y + type(psb_zspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + type(psb_z_vect_type), intent(inout), optional :: diag + complex(psb_dpk_), optional, target, intent(inout) :: work(:) + character, intent(in), optional :: trans, scale + integer, intent(in), optional :: choice + + ! locals + integer :: ictxt, np, me, & + & err_act, iix, jjx, ia, ja, iia, jja, lldx,lldy, choice_,& + & ix, iy, ik, jx, jy, i, lld,& + & m, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm + + character :: lscale + integer, parameter :: nb=4 + complex(psb_dpk_),pointer :: iwork(:), xp(:), yp(:) + character :: itrans + character(len=20) :: name, ch_err + logical :: aliw + + name='psb_sspsv' + if (psb_errstatus_fatal()) return + info=psb_success_ + call psb_erractionsave(err_act) + + ictxt=desc_a%get_context() + + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(y%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + ! just this case right now + ia = 1 + ja = 1 + ix = 1 + iy = 1 + ik = 1 + jx = 1 + jy = 1 + + if (present(choice)) then + choice_ = choice + else + choice_ = psb_avg_ + endif + + if (present(scale)) then + lscale = psb_toupper(scale) + else + lscale = 'U' + endif + + if (present(trans)) then + itrans = psb_toupper(trans) + if((itrans == 'N').or.(itrans == 'T').or.(itrans == 'C')) then + ! Ok + else + info = psb_err_iarg_invalid_value_ + call psb_errpush(info,name) + goto 9999 + end if + else + itrans = 'N' + endif + + m = desc_a%get_global_rows() + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + lldx = x%get_nrows() + lldy = y%get_nrows() + + if((lldx < ncol).or.(lldy < ncol)) then + info=psb_err_lld_case_not_implemented_ + call psb_errpush(info,name) + goto 9999 + end if + + iwork => null() + ! check for presence/size of a work area + liwork= 2*ncol + + if (present(work)) then + if (size(work) >= liwork) then + aliw =.false. + else + aliw=.true. + endif + else + aliw=.true. + end if + + if (aliw) then + allocate(iwork(liwork),stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_realloc' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + else + iwork => work + endif + + iwork(1)=0.d0 + + ! checking for matrix correctness + call psb_chkmat(m,m,ia,ja,desc_a,info,iia,jja) + ! checking for vectors correctness + if (info == psb_success_) & + & call psb_chkvect(m,ik,x%get_nrows(),ix,jx,desc_a,info,iix,jjx) + if (info == psb_success_)& + & call psb_chkvect(m,ik,y%get_nrows(),iy,jy,desc_a,info,iiy,jjy) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_chkvect/mat' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if(ja /= ix) then + ! this case is not yet implemented + info = psb_err_ja_nix_ia_niy_unsupported_ + end if + + if((iix /= 1).or.(iiy /= 1)) then + ! this case is not yet implemented + info = psb_err_ix_n1_iy_n1_unsupported_ + end if + + if(info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + + ! Perform local triangular system solve + if (present(diag)) then + call a%cssm(alpha,x,beta,y,info,scale=scale,d=diag,trans=trans) + else + call a%cssm(alpha,x,beta,y,info,scale=scale,trans=trans) + end if + if(info /= psb_success_) then + info = psb_err_from_subroutine_ + ch_err='dcssm' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + ! update overlap elements + if (choice_ > 0) then + call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),& + & zone,y%v,desc_a,iwork,info,data=psb_comm_ovr_) + + + if (info == psb_success_) call psi_ovrl_upd(y%v,desc_a,choice_,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='Inner updates') + goto 9999 + end if + end if + + if (aliw) deallocate(iwork) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return +end subroutine psb_zspsv_vect + diff --git a/base/serial/Makefile b/base/serial/Makefile index c969ea100..1222ba7ee 100644 --- a/base/serial/Makefile +++ b/base/serial/Makefile @@ -6,7 +6,8 @@ FOBJS = psb_lsame.o psi_serial_impl.o psb_sort_impl.o \ psb_ssymbmm.o psb_dsymbmm.o psb_csymbmm.o psb_zsymbmm.o \ psb_snumbmm.o psb_dnumbmm.o psb_cnumbmm.o psb_znumbmm.o \ psb_sgeprt.o psb_dgeprt.o psb_cgeprt.o psb_zgeprt.o\ - psb_spdot_srtd.o psb_aspxpby.o psb_spge_dot.o + psb_spdot_srtd.o psb_aspxpby.o psb_spge_dot.o\ + psb_sgelp.o psb_dgelp.o psb_cgelp.o psb_zgelp.o LIBDIR=.. MODDIR=../modules diff --git a/base/serial/impl/psb_c_base_mat_impl.f90 b/base/serial/impl/psb_c_base_mat_impl.f90 index aecc3cbf9..f70adb1ce 100644 --- a/base/serial/impl/psb_c_base_mat_impl.f90 +++ b/base/serial/impl/psb_c_base_mat_impl.f90 @@ -1036,6 +1036,35 @@ subroutine psb_c_base_scal(d,a,info) end subroutine psb_c_base_scal +function psb_c_base_maxval(a) result(res) + use psb_error_mod + use psb_const_mod + use psb_c_base_mat_mod, psb_protect_name => psb_c_base_maxval + + implicit none + class(psb_c_base_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + + Integer :: err_act, info + character(len=20) :: name='maxval' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + ! This is the base version. If we get here + ! it means the derived class is incomplete, + ! so we throw an error. + info = psb_err_missing_override_method_ + call psb_errpush(info,name,a_err=a%get_fmt()) + + if (err_act /= psb_act_ret_) then + call psb_error() + end if + res = -sone + + return + +end function psb_c_base_maxval + function psb_c_base_csnmi(a) result(res) use psb_error_mod @@ -1060,12 +1089,145 @@ function psb_c_base_csnmi(a) result(res) if (err_act /= psb_act_ret_) then call psb_error() end if - res = -done + res = -sone return end function psb_c_base_csnmi +function psb_c_base_csnm1(a) result(res) + use psb_error_mod + use psb_const_mod + use psb_c_base_mat_mod, psb_protect_name => psb_c_base_csnm1 + + implicit none + class(psb_c_base_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + + Integer :: err_act, info + character(len=20) :: name='csnm1' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + ! This is the base version. If we get here + ! it means the derived class is incomplete, + ! so we throw an error. + info = psb_err_missing_override_method_ + call psb_errpush(info,name,a_err=a%get_fmt()) + + if (err_act /= psb_act_ret_) then + call psb_error() + end if + res = -sone + + return + +end function psb_c_base_csnm1 + +subroutine psb_c_base_rowsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_c_base_mat_mod, psb_protect_name => psb_c_base_rowsum + class(psb_c_base_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(out) :: d(:) + + Integer :: err_act, info + character(len=20) :: name='rowsum' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + ! This is the base version. If we get here + ! it means the derived class is incomplete, + ! so we throw an error. + info = psb_err_missing_override_method_ + call psb_errpush(info,name,a_err=a%get_fmt()) + + if (err_act /= psb_act_ret_) then + call psb_error() + end if + + return + +end subroutine psb_c_base_rowsum + +subroutine psb_c_base_arwsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_c_base_mat_mod, psb_protect_name => psb_c_base_arwsum + class(psb_c_base_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + + Integer :: err_act, info + character(len=20) :: name='arwsum' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + ! This is the base version. If we get here + ! it means the derived class is incomplete, + ! so we throw an error. + info = psb_err_missing_override_method_ + call psb_errpush(info,name,a_err=a%get_fmt()) + + if (err_act /= psb_act_ret_) then + call psb_error() + end if + + return + +end subroutine psb_c_base_arwsum + +subroutine psb_c_base_colsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_c_base_mat_mod, psb_protect_name => psb_c_base_colsum + class(psb_c_base_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(out) :: d(:) + + Integer :: err_act, info + character(len=20) :: name='colsum' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + ! This is the base version. If we get here + ! it means the derived class is incomplete, + ! so we throw an error. + info = psb_err_missing_override_method_ + call psb_errpush(info,name,a_err=a%get_fmt()) + + if (err_act /= psb_act_ret_) then + call psb_error() + end if + + return + +end subroutine psb_c_base_colsum + +subroutine psb_c_base_aclsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_c_base_mat_mod, psb_protect_name => psb_c_base_aclsum + class(psb_c_base_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + + Integer :: err_act, info + character(len=20) :: name='aclsum' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + ! This is the base version. If we get here + ! it means the derived class is incomplete, + ! so we throw an error. + info = psb_err_missing_override_method_ + call psb_errpush(info,name,a_err=a%get_fmt()) + + if (err_act /= psb_act_ret_) then + call psb_error() + end if + + return + +end subroutine psb_c_base_aclsum + subroutine psb_c_base_get_diag(a,d,info) use psb_error_mod use psb_const_mod @@ -1097,4 +1259,224 @@ end subroutine psb_c_base_get_diag +! == ================================== +! +! +! +! Computational routines for C_VECT +! variables. If the actual data type is +! a "normal" one, these are sufficient. +! +! +! +! +! == ================================== + + + +subroutine psb_c_base_vect_mv(alpha,a,x,beta,y,info,trans) + use psb_error_mod + use psb_const_mod + use psb_c_base_mat_mod, psb_protect_name => psb_c_base_vect_mv + implicit none + class(psb_c_base_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta + class(psb_c_base_vect_type), intent(inout) :: x + class(psb_c_base_vect_type), intent(inout) :: y + integer, intent(out) :: info + character, optional, intent(in) :: trans + + ! For the time being we just throw everything back + ! onto the normal routines. + call x%sync() + call y%sync() + call a%csmm(alpha,x%v,beta,y%v,info,trans) + +end subroutine psb_c_base_vect_mv + +subroutine psb_c_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d) + use psb_c_base_mat_mod, psb_protect_name => psb_c_base_vect_cssv + use psb_c_base_vect_mod + use psb_error_mod + use psb_string_mod + implicit none + class(psb_c_base_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta + class(psb_c_base_vect_type), intent(inout) :: x,y + integer, intent(out) :: info + character, optional, intent(in) :: trans, scale + class(psb_c_base_vect_type), intent(inout),optional :: d + + complex(psb_spk_), allocatable :: tmp(:) + class(psb_c_base_vect_type), allocatable :: tmpv + Integer :: err_act, nar,nac,nc, i + character(len=1) :: scale_ + character(len=20) :: name='s_cssm' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + nar = a%get_nrows() + nac = a%get_ncols() + nc = 1 + if (x%get_nrows() < nac) then + info = 36 + call psb_errpush(info,name,i_err=(/3,nac,0,0,0/)) + goto 9999 + end if + if (y%get_nrows() < nar) then + info = 36 + call psb_errpush(info,name,i_err=(/3,nar,0,0,0/)) + goto 9999 + end if + + if (.not. (a%is_triangle())) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + end if + + call x%sync() + call y%sync() + if (present(d)) then + call d%sync() + if (present(scale)) then + scale_ = scale + else + scale_ = 'L' + end if + + if (psb_toupper(scale_) == 'R') then + if (d%get_nrows() < nac) then + info = 36 + call psb_errpush(info,name,i_err=(/9,nac,0,0,0/)) + goto 9999 + end if + + allocate(tmpv, mold=y,stat=info) + ! allocate(tmp(nac),stat=info) + if (info /= psb_success_) info = psb_err_alloc_dealloc_ + if (info == psb_success_) call tmpv%mlt(cone,d%v(1:nac),x,czero,info) + if (info == psb_success_)& + & call a%inner_cssm(alpha,tmpv,beta,y,info,trans) + + if (info == psb_success_) then + call tmpv%free(info) + if (info == psb_success_) deallocate(tmpv,stat=info) + if (info /= psb_success_) info = psb_err_alloc_dealloc_ + end if + + else if (psb_toupper(scale_) == 'L') then + if (d%get_nrows() < nar) then + info = 36 + call psb_errpush(info,name,i_err=(/9,nar,0,0,0/)) + goto 9999 + end if + + if (beta == czero) then + call a%inner_cssm(alpha,x,czero,y,info,trans) + if (info == psb_success_) call y%mlt(d%v(1:nar),info) +!!$ if (info == psb_success_) call inner_vscal1(nar,d,y) + else + ! allocate(tmp(nar),stat=info) + allocate(tmpv, mold=y,stat=info) + if (info /= psb_success_) info = psb_err_alloc_dealloc_ + if (info == psb_success_)& + & call a%inner_cssm(alpha,x,czero,tmpv,info,trans) + + if (info == psb_success_) call tmpv%mlt(d%v(1:nar),info) + if (info == psb_success_)& + & call y%axpby(nar,cone,tmpv,beta,info) + if (info == psb_success_) then + call tmpv%free(info) + if (info == psb_success_) deallocate(tmpv,stat=info) + if (info /= psb_success_) info = psb_err_alloc_dealloc_ + end if + end if + + else + info = 31 + call psb_errpush(info,name,i_err=(/8,0,0,0,0/),a_err=scale_) + goto 9999 + end if + else + ! Scale is ignored in this case + call a%inner_cssm(alpha,x,beta,y,info,trans) + end if + + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='inner_cssm') + 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 psb_c_base_vect_cssv + + +subroutine psb_c_base_inner_vect_sv(alpha,a,x,beta,y,info,trans) + use psb_c_base_mat_mod, psb_protect_name => psb_c_base_inner_vect_sv + use psb_error_mod + use psb_string_mod + use psb_c_base_vect_mod + implicit none + class(psb_c_base_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta + class(psb_c_base_vect_type), intent(inout) :: x, y + integer, intent(out) :: info + character, optional, intent(in) :: trans + + Integer :: err_act + character(len=20) :: name='s_base_inner_vect_sv' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + ! This is the base version. If we get here + ! it means the derived class is incomplete, + ! so we throw an error. + info = psb_success_ + + call a%inner_cssm(alpha,x%v,beta,y%v,info,trans) + + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='inner_cssm') + 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 psb_c_base_inner_vect_sv + diff --git a/base/serial/impl/psb_c_coo_impl.f90 b/base/serial/impl/psb_c_coo_impl.f90 index 6b9a50afa..1420301e0 100644 --- a/base/serial/impl/psb_c_coo_impl.f90 +++ b/base/serial/impl/psb_c_coo_impl.f90 @@ -1565,6 +1565,26 @@ subroutine psb_c_coo_csmm(alpha,a,x,beta,y,info,trans) end subroutine psb_c_coo_csmm +function psb_c_coo_maxval(a) result(res) + use psb_error_mod + use psb_c_base_mat_mod, psb_protect_name => psb_c_coo_maxval + implicit none + class(psb_c_coo_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + + integer :: i,j,k,m,n, nnz, ir, jc, nc, info + character(len=20) :: name='c_coo_maxval' + logical, parameter :: debug=.false. + + + res = szero + nnz = a%get_nzeros() + if (allocated(a%val)) then + nnz = min(nnz,size(a%val)) + res = maxval(abs(a%val(1:nnz))) + end if +end function psb_c_coo_maxval + function psb_c_coo_csnmi(a) result(res) use psb_error_mod use psb_c_base_mat_mod, psb_protect_name => psb_c_coo_csnmi @@ -1599,6 +1619,238 @@ function psb_c_coo_csnmi(a) result(res) end function psb_c_coo_csnmi +function psb_c_coo_csnm1(a) result(res) + use psb_error_mod + use psb_const_mod + use psb_c_base_mat_mod, psb_protect_name => psb_c_coo_csnm1 + + implicit none + class(psb_c_coo_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + + integer :: i,j,k,m,n, nnz, ir, jc, nc, info + real(psb_spk_) :: acc + real(psb_spk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act + character(len=20) :: name='d_coo_csnm1' + logical, parameter :: debug=.false. + + + res = -done + nnz = a%get_nzeros() + n = a%get_ncols() + allocate(vt(n),stat=info) + if (info /= 0) return + vt(:) = szero + do j=1, nnz + i = a%ja(j) + vt(i) = vt(i) + abs(a%val(j)) + end do + res = maxval(vt(1:n)) + deallocate(vt,stat=info) + + return + +end function psb_c_coo_csnm1 + +subroutine psb_c_coo_rowsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_c_base_mat_mod, psb_protect_name => psb_c_coo_rowsum + class(psb_c_coo_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + complex(psb_spk_) :: acc + complex(psb_spk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='rowsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + m = a%get_nrows() + if (size(d) < m) then + info=psb_err_input_asize_small_i_ + int_err(1) = 1 + int_err(2) = size(d) + int_err(3) = m + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + d = czero + nnz = a%get_nzeros() + do j=1, nnz + i = a%ia(j) + d(i) = d(i) + a%val(j) + end do + + return + 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 psb_c_coo_rowsum + +subroutine psb_c_coo_arwsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_c_base_mat_mod, psb_protect_name => psb_c_coo_arwsum + class(psb_c_coo_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + real(psb_spk_) :: acc + real(psb_spk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='rowsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + m = a%get_nrows() + if (size(d) < m) then + info=psb_err_input_asize_small_i_ + int_err(1) = 1 + int_err(2) = size(d) + int_err(3) = m + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + d = szero + nnz = a%get_nzeros() + do j=1, nnz + i = a%ia(j) + d(i) = d(i) + abs(a%val(j)) + end do + + return + 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 psb_c_coo_arwsum + +subroutine psb_c_coo_colsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_c_base_mat_mod, psb_protect_name => psb_c_coo_colsum + class(psb_c_coo_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + complex(psb_spk_) :: acc + complex(psb_spk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='colsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + n = a%get_ncols() + if (size(d) < n) then + info=psb_err_input_asize_small_i_ + int_err(1) = 1 + int_err(2) = size(d) + int_err(3) = n + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + d = czero + nnz = a%get_nzeros() + do j=1, nnz + k = a%ja(j) + d(k) = d(k) + a%val(j) + end do + + return + 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 psb_c_coo_colsum + +subroutine psb_c_coo_aclsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_c_base_mat_mod, psb_protect_name => psb_c_coo_aclsum + class(psb_c_coo_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + real(psb_spk_) :: acc + real(psb_spk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='aclsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + n = a%get_ncols() + if (size(d) < n) then + info=psb_err_input_asize_small_i_ + int_err(1) = 1 + int_err(2) = size(d) + int_err(3) = n + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + d = szero + nnz = a%get_nzeros() + do j=1, nnz + k = a%ja(j) + d(k) = d(k) + abs(a%val(j)) + end do + + return + 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 psb_c_coo_aclsum + + ! == ================================== ! diff --git a/base/serial/impl/psb_c_csc_impl.f90 b/base/serial/impl/psb_c_csc_impl.f90 index 296d8a54f..861b87de7 100644 --- a/base/serial/impl/psb_c_csc_impl.f90 +++ b/base/serial/impl/psb_c_csc_impl.f90 @@ -1388,6 +1388,26 @@ contains end subroutine psb_c_csc_cssm +function psb_c_csc_maxval(a) result(res) + use psb_error_mod + use psb_c_csc_mat_mod, psb_protect_name => psb_c_csc_maxval + implicit none + class(psb_c_csc_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + + integer :: i,j,k,m,n, nnz, ir, jc, nc, info + character(len=20) :: name='c_csc_maxval' + logical, parameter :: debug=.false. + + + res = szero + nnz = a%get_nzeros() + if (allocated(a%val)) then + nnz = min(nnz,size(a%val)) + res = maxval(abs(a%val(1:nnz))) + end if +end function psb_c_csc_maxval + function psb_c_csc_csnmi(a) result(res) use psb_error_mod use psb_c_csc_mat_mod, psb_protect_name => psb_c_csc_csnmi @@ -1424,6 +1444,242 @@ function psb_c_csc_csnmi(a) result(res) end function psb_c_csc_csnmi +function psb_c_csc_csnm1(a) result(res) + use psb_error_mod + use psb_const_mod + use psb_c_csc_mat_mod, psb_protect_name => psb_c_csc_csnm1 + + implicit none + class(psb_c_csc_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + + integer :: i,j,k,m,n, nnz, ir, jc, nc, info + real(psb_spk_) :: acc + real(psb_spk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act + character(len=20) :: name='d_csc_csnm1' + logical, parameter :: debug=.false. + + + res = szero + m = a%get_nrows() + n = a%get_ncols() + do j=1, n + acc = szero + do k=a%icp(j),a%icp(j+1)-1 + acc = acc + abs(a%val(k)) + end do + res = max(res,acc) + end do + + return + +end function psb_c_csc_csnm1 + +subroutine psb_c_csc_colsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_c_csc_mat_mod, psb_protect_name => psb_c_csc_colsum + class(psb_c_csc_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + complex(psb_spk_) :: acc + complex(psb_spk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='colsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + m = a%get_ncols() + if (size(d) < m) then + info=psb_err_input_asize_small_i_ + int_err(1) = 1 + int_err(2) = size(d) + int_err(3) = m + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + do i = 1, a%get_ncols() + d(i) = czero + do j=a%icp(i),a%icp(i+1)-1 + d(i) = d(i) + (a%val(j)) + end do + end do + + return + 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 psb_c_csc_colsum + +subroutine psb_c_csc_aclsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_c_csc_mat_mod, psb_protect_name => psb_c_csc_aclsum + class(psb_c_csc_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + real(psb_spk_) :: acc + real(psb_spk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='colsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + m = a%get_ncols() + if (size(d) < m) then + info=psb_err_input_asize_small_i_ + int_err(1) = 1 + int_err(2) = size(d) + int_err(3) = m + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + + do i = 1, a%get_ncols() + d(i) = szero + do j=a%icp(i),a%icp(i+1)-1 + d(i) = d(i) + abs(a%val(j)) + end do + 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 psb_c_csc_aclsum + +subroutine psb_c_csc_rowsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_c_csc_mat_mod, psb_protect_name => psb_c_csc_rowsum + class(psb_c_csc_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + complex(psb_spk_) :: acc + complex(psb_spk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='rowsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + m = a%get_ncols() + n = a%get_nrows() + if (size(d) < n) then + info=psb_err_input_asize_small_i_ + int_err(1) = 1 + int_err(2) = size(d) + int_err(3) = n + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + d = czero + + do i=1, m + do j=a%icp(i),a%icp(i+1)-1 + k = a%ia(j) + d(k) = d(k) + (a%val(k)) + end do + end do + + return + 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 psb_c_csc_rowsum + +subroutine psb_c_csc_arwsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_c_csc_mat_mod, psb_protect_name => psb_c_csc_arwsum + class(psb_c_csc_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + real(psb_spk_) :: acc + real(psb_spk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='arwsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + m = a%get_ncols() + n = a%get_nrows() + if (size(d) < n) then + info=psb_err_input_asize_small_i_ + int_err(1) = 1 + int_err(2) = size(d) + int_err(3) = n + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + d = szero + + do i=1, m + do j=a%icp(i),a%icp(i+1)-1 + k = a%ia(j) + d(k) = d(k) + abs(a%val(k)) + end do + end do + + return + 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 psb_c_csc_arwsum + + subroutine psb_c_csc_get_diag(a,d,info) use psb_error_mod use psb_const_mod diff --git a/base/serial/impl/psb_c_csr_impl.f90 b/base/serial/impl/psb_c_csr_impl.f90 index d5f58005f..8dbc797d8 100644 --- a/base/serial/impl/psb_c_csr_impl.f90 +++ b/base/serial/impl/psb_c_csr_impl.f90 @@ -1236,6 +1236,26 @@ contains end subroutine psb_c_csr_cssm +function psb_c_csr_maxval(a) result(res) + use psb_error_mod + use psb_c_csr_mat_mod, psb_protect_name => psb_c_csr_maxval + implicit none + class(psb_c_csr_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + + integer :: i,j,k,m,n, nnz, ir, jc, nc, info + character(len=20) :: name='c_csr_maxval' + logical, parameter :: debug=.false. + + + res = szero + nnz = a%get_nzeros() + if (allocated(a%val)) then + nnz = min(nnz,size(a%val)) + res = maxval(abs(a%val(1:nnz))) + end if +end function psb_c_csr_maxval + function psb_c_csr_csnmi(a) result(res) use psb_error_mod use psb_c_csr_mat_mod, psb_protect_name => psb_c_csr_csnmi @@ -1263,6 +1283,246 @@ function psb_c_csr_csnmi(a) result(res) end function psb_c_csr_csnmi +function psb_c_csr_csnm1(a) result(res) + use psb_error_mod + use psb_const_mod + use psb_c_csr_mat_mod, psb_protect_name => psb_c_csr_csnm1 + + implicit none + class(psb_c_csr_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + + integer :: i,j,k,m,n, nnz, ir, jc, nc, info + real(psb_spk_) :: acc + real(psb_spk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act + character(len=20) :: name='d_csr_csnm1' + logical, parameter :: debug=.false. + + + res = -sone + nnz = a%get_nzeros() + m = a%get_nrows() + n = a%get_ncols() + allocate(vt(n),stat=info) + if (info /= 0) return + vt(:) = szero + do i=1, m + do j=a%irp(i),a%irp(i+1)-1 + k = a%ja(j) + vt(k) = vt(k) + abs(a%val(j)) + end do + end do + res = maxval(vt(1:n)) + deallocate(vt,stat=info) + + return + +end function psb_c_csr_csnm1 + +subroutine psb_c_csr_rowsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_c_csr_mat_mod, psb_protect_name => psb_c_csr_rowsum + class(psb_c_csr_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + complex(psb_spk_) :: acc + complex(psb_spk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='rowsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + m = a%get_nrows() + if (size(d) < m) then + info=psb_err_input_asize_small_i_ + int_err(1) = 1 + int_err(2) = size(d) + int_err(3) = m + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + do i = 1, a%get_nrows() + d(i) = czero + do j=a%irp(i),a%irp(i+1)-1 + d(i) = d(i) + (a%val(j)) + end do + end do + + return + 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 psb_c_csr_rowsum + +subroutine psb_c_csr_arwsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_c_csr_mat_mod, psb_protect_name => psb_c_csr_arwsum + class(psb_c_csr_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + real(psb_spk_) :: acc + real(psb_spk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='rowsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + m = a%get_nrows() + if (size(d) < m) then + info=psb_err_input_asize_small_i_ + int_err(1) = 1 + int_err(2) = size(d) + int_err(3) = m + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + + do i = 1, a%get_nrows() + d(i) = szero + do j=a%irp(i),a%irp(i+1)-1 + d(i) = d(i) + abs(a%val(j)) + end do + 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 psb_c_csr_arwsum + +subroutine psb_c_csr_colsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_c_csr_mat_mod, psb_protect_name => psb_c_csr_colsum + class(psb_c_csr_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + complex(psb_spk_) :: acc + complex(psb_spk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='colsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + m = a%get_nrows() + n = a%get_ncols() + if (size(d) < n) then + info=psb_err_input_asize_small_i_ + int_err(1) = 1 + int_err(2) = size(d) + int_err(3) = n + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + d = czero + + do i=1, m + do j=a%irp(i),a%irp(i+1)-1 + k = a%ja(j) + d(k) = d(k) + (a%val(j)) + end do + end do + + return + 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 psb_c_csr_colsum + +subroutine psb_c_csr_aclsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_c_csr_mat_mod, psb_protect_name => psb_c_csr_aclsum + class(psb_c_csr_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + real(psb_spk_) :: acc + real(psb_spk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='aclsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + m = a%get_nrows() + n = a%get_ncols() + if (size(d) < n) then + info=psb_err_input_asize_small_i_ + int_err(1) = 1 + int_err(2) = size(d) + int_err(3) = n + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + d = szero + + do i=1, m + do j=a%irp(i),a%irp(i+1)-1 + k = a%ja(j) + d(k) = d(k) + abs(a%val(j)) + end do + end do + + return + 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 psb_c_csr_aclsum + subroutine psb_c_csr_get_diag(a,d,info) use psb_error_mod use psb_const_mod diff --git a/base/serial/impl/psb_c_mat_impl.F90 b/base/serial/impl/psb_c_mat_impl.F90 index 3df591bf8..db9603ac1 100644 --- a/base/serial/impl/psb_c_mat_impl.F90 +++ b/base/serial/impl/psb_c_mat_impl.F90 @@ -1836,6 +1836,56 @@ subroutine psb_c_csmv(alpha,a,x,beta,y,info,trans) end subroutine psb_c_csmv +subroutine psb_c_csmv_vect(alpha,a,x,beta,y,info,trans) + use psb_error_mod + use psb_c_vect_mod + use psb_c_mat_mod, psb_protect_name => psb_c_csmv_vect + implicit none + class(psb_cspmat_type), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta + type(psb_c_vect_type), intent(inout) :: x + type(psb_c_vect_type), intent(inout) :: y + integer, intent(out) :: info + character, optional, intent(in) :: trans + Integer :: err_act + character(len=20) :: name='psb_csmv' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + if (.not.allocated(a%a)) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(y%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + call a%a%csmm(alpha,x%v,beta,y%v,info,trans) + if (info /= psb_success_) 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 psb_c_csmv_vect + subroutine psb_c_cssm(alpha,a,x,beta,y,info,trans,scale,d) use psb_error_mod @@ -1918,6 +1968,99 @@ subroutine psb_c_cssv(alpha,a,x,beta,y,info,trans,scale,d) end subroutine psb_c_cssv +subroutine psb_c_cssv_vect(alpha,a,x,beta,y,info,trans,scale,d) + use psb_error_mod + use psb_c_vect_mod + use psb_c_mat_mod, psb_protect_name => psb_c_cssv_vect + implicit none + class(psb_cspmat_type), intent(in) :: a + complex(psb_spk_), intent(in) :: alpha, beta + type(psb_c_vect_type), intent(inout) :: x + type(psb_c_vect_type), intent(inout) :: y + integer, intent(out) :: info + character, optional, intent(in) :: trans, scale + type(psb_c_vect_type), optional, intent(inout) :: d + Integer :: err_act + character(len=20) :: name='psb_cssv' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + if (.not.allocated(a%a)) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(y%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (present(d)) then + if (.not.allocated(d%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + call a%a%cssm(alpha,x%v,beta,y%v,info,trans,scale,d%v) + else + call a%a%cssm(alpha,x%v,beta,y%v,info,trans,scale) + end if + + if (info /= psb_success_) 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 psb_c_cssv_vect + + +function psb_c_maxval(a) result(res) + use psb_c_mat_mod, psb_protect_name => psb_c_maxval + use psb_error_mod + use psb_const_mod + implicit none + class(psb_cspmat_type), intent(in) :: a + real(psb_spk_) :: res + + Integer :: err_act, info + character(len=20) :: name='maxval' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + info = psb_success_ + if (.not.allocated(a%a)) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + res = a%a%maxval() + return + +9999 continue + + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + +end function psb_c_maxval function psb_c_csnmi(a) result(res) use psb_c_mat_mod, psb_protect_name => psb_c_csnmi @@ -1952,6 +2095,192 @@ function psb_c_csnmi(a) result(res) end function psb_c_csnmi +function psb_c_csnm1(a) result(res) + use psb_c_mat_mod, psb_protect_name => psb_c_csnm1 + use psb_error_mod + use psb_const_mod + implicit none + class(psb_cspmat_type), intent(in) :: a + real(psb_spk_) :: res + + Integer :: err_act, info + character(len=20) :: name='csnm1' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + info = psb_success_ + if (.not.allocated(a%a)) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + res = a%a%csnm1() + return + +9999 continue + + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + +end function psb_c_csnm1 + + +subroutine psb_c_rowsum(d,a,info) + use psb_c_mat_mod, psb_protect_name => psb_c_rowsum + use psb_error_mod + use psb_const_mod + implicit none + class(psb_cspmat_type), intent(in) :: a + complex(psb_spk_), intent(out) :: d(:) + integer, intent(out) :: info + + Integer :: err_act + character(len=20) :: name='rowsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + if (.not.allocated(a%a)) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + call a%a%rowsum(d) + if (info /= psb_success_) 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 psb_c_rowsum + +subroutine psb_c_arwsum(d,a,info) + use psb_c_mat_mod, psb_protect_name => psb_c_arwsum + use psb_error_mod + use psb_const_mod + implicit none + class(psb_cspmat_type), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + integer, intent(out) :: info + + Integer :: err_act + character(len=20) :: name='arwsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + if (.not.allocated(a%a)) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + call a%a%arwsum(d) + if (info /= psb_success_) 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 psb_c_arwsum + +subroutine psb_c_colsum(d,a,info) + use psb_c_mat_mod, psb_protect_name => psb_c_colsum + use psb_error_mod + use psb_const_mod + implicit none + class(psb_cspmat_type), intent(in) :: a + complex(psb_spk_), intent(out) :: d(:) + integer, intent(out) :: info + + Integer :: err_act + character(len=20) :: name='colsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + if (.not.allocated(a%a)) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + call a%a%colsum(d) + if (info /= psb_success_) 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 psb_c_colsum + +subroutine psb_c_aclsum(d,a,info) + use psb_c_mat_mod, psb_protect_name => psb_c_aclsum + use psb_error_mod + use psb_const_mod + implicit none + class(psb_cspmat_type), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + integer, intent(out) :: info + + Integer :: err_act + character(len=20) :: name='aclsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + if (.not.allocated(a%a)) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + call a%a%aclsum(d) + if (info /= psb_success_) 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 psb_c_aclsum + subroutine psb_c_get_diag(a,d,info) use psb_c_mat_mod, psb_protect_name => psb_c_get_diag diff --git a/base/serial/impl/psb_d_base_mat_impl.f90 b/base/serial/impl/psb_d_base_mat_impl.f90 index 4ffa18e7e..721696237 100644 --- a/base/serial/impl/psb_d_base_mat_impl.f90 +++ b/base/serial/impl/psb_d_base_mat_impl.f90 @@ -1037,6 +1037,35 @@ end subroutine psb_d_base_scal +function psb_d_base_maxval(a) result(res) + use psb_error_mod + use psb_const_mod + use psb_d_base_mat_mod, psb_protect_name => psb_d_base_maxval + + implicit none + class(psb_d_base_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + + Integer :: err_act, info + character(len=20) :: name='maxval' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + ! This is the base version. If we get here + ! it means the derived class is incomplete, + ! so we throw an error. + info = psb_err_missing_override_method_ + call psb_errpush(info,name,a_err=a%get_fmt()) + + if (err_act /= psb_act_ret_) then + call psb_error() + end if + res = -done + + return + +end function psb_d_base_maxval + function psb_d_base_csnmi(a) result(res) use psb_error_mod use psb_const_mod @@ -1230,5 +1259,222 @@ subroutine psb_d_base_get_diag(a,d,info) end subroutine psb_d_base_get_diag +! == ================================== +! +! +! +! Computational routines for D_VECT +! variables. If the actual data type is +! a "normal" one, these are sufficient. +! +! +! +! +! == ================================== + +subroutine psb_d_base_vect_mv(alpha,a,x,beta,y,info,trans) + use psb_error_mod + use psb_const_mod + use psb_d_base_mat_mod, psb_protect_name => psb_d_base_vect_mv + implicit none + class(psb_d_base_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta + class(psb_d_base_vect_type), intent(inout) :: x + class(psb_d_base_vect_type), intent(inout) :: y + integer, intent(out) :: info + character, optional, intent(in) :: trans + + ! For the time being we just throw everything back + ! onto the normal routines. + call x%sync() + call y%sync() + call a%csmm(alpha,x%v,beta,y%v,info,trans) + +end subroutine psb_d_base_vect_mv + +subroutine psb_d_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d) + use psb_d_base_mat_mod, psb_protect_name => psb_d_base_vect_cssv + use psb_d_base_vect_mod + use psb_error_mod + use psb_string_mod + implicit none + class(psb_d_base_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta + class(psb_d_base_vect_type), intent(inout) :: x,y + integer, intent(out) :: info + character, optional, intent(in) :: trans, scale + class(psb_d_base_vect_type), intent(inout),optional :: d + + real(psb_dpk_), allocatable :: tmp(:) + class(psb_d_base_vect_type), allocatable :: tmpv + Integer :: err_act, nar,nac,nc, i + character(len=1) :: scale_ + character(len=20) :: name='d_cssm' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + nar = a%get_nrows() + nac = a%get_ncols() + nc = 1 + if (x%get_nrows() < nac) then + info = 36 + call psb_errpush(info,name,i_err=(/3,nac,0,0,0/)) + goto 9999 + end if + if (y%get_nrows() < nar) then + info = 36 + call psb_errpush(info,name,i_err=(/3,nar,0,0,0/)) + goto 9999 + end if + + if (.not. (a%is_triangle())) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + end if + + call x%sync() + call y%sync() + if (present(d)) then + call d%sync() + if (present(scale)) then + scale_ = scale + else + scale_ = 'L' + end if + + if (psb_toupper(scale_) == 'R') then + if (d%get_nrows() < nac) then + info = 36 + call psb_errpush(info,name,i_err=(/9,nac,0,0,0/)) + goto 9999 + end if + + allocate(tmpv, mold=y,stat=info) + ! allocate(tmp(nac),stat=info) + if (info /= psb_success_) info = psb_err_alloc_dealloc_ + if (info == psb_success_) call tmpv%mlt(done,d%v(1:nac),x,dzero,info) + if (info == psb_success_)& + & call a%inner_cssm(alpha,tmpv,beta,y,info,trans) + + if (info == psb_success_) then + call tmpv%free(info) + if (info == psb_success_) deallocate(tmpv,stat=info) + if (info /= psb_success_) info = psb_err_alloc_dealloc_ + end if + + else if (psb_toupper(scale_) == 'L') then + if (d%get_nrows() < nar) then + info = 36 + call psb_errpush(info,name,i_err=(/9,nar,0,0,0/)) + goto 9999 + end if + + if (beta == dzero) then + call a%inner_cssm(alpha,x,dzero,y,info,trans) + if (info == psb_success_) call y%mlt(d%v(1:nar),info) +!!$ if (info == psb_success_) call inner_vscal1(nar,d,y) + else + ! allocate(tmp(nar),stat=info) + allocate(tmpv, mold=y,stat=info) + if (info /= psb_success_) info = psb_err_alloc_dealloc_ + if (info == psb_success_)& + & call a%inner_cssm(alpha,x,dzero,tmpv,info,trans) + + if (info == psb_success_) call tmpv%mlt(d%v(1:nar),info) + if (info == psb_success_)& + & call y%axpby(nar,done,tmpv,beta,info) + if (info == psb_success_) then + call tmpv%free(info) + if (info == psb_success_) deallocate(tmpv,stat=info) + if (info /= psb_success_) info = psb_err_alloc_dealloc_ + end if + end if + + else + info = 31 + call psb_errpush(info,name,i_err=(/8,0,0,0,0/),a_err=scale_) + goto 9999 + end if + else + ! Scale is ignored in this case + call a%inner_cssm(alpha,x,beta,y,info,trans) + end if + + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='inner_cssm') + 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 psb_d_base_vect_cssv + + +subroutine psb_d_base_inner_vect_sv(alpha,a,x,beta,y,info,trans) + use psb_d_base_mat_mod, psb_protect_name => psb_d_base_inner_vect_sv + use psb_error_mod + use psb_string_mod + use psb_d_base_vect_mod + implicit none + class(psb_d_base_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta + class(psb_d_base_vect_type), intent(inout) :: x, y + integer, intent(out) :: info + character, optional, intent(in) :: trans + + Integer :: err_act + character(len=20) :: name='d_base_inner_vect_sv' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + ! This is the base version. If we get here + ! it means the derived class is incomplete, + ! so we throw an error. + info = psb_success_ + + call a%inner_cssm(alpha,x%v,beta,y%v,info,trans) + + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='inner_cssm') + 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 psb_d_base_inner_vect_sv diff --git a/base/serial/impl/psb_d_coo_impl.f90 b/base/serial/impl/psb_d_coo_impl.f90 index 3ae77b36b..01d125070 100644 --- a/base/serial/impl/psb_d_coo_impl.f90 +++ b/base/serial/impl/psb_d_coo_impl.f90 @@ -1365,6 +1365,26 @@ subroutine psb_d_coo_csmm(alpha,a,x,beta,y,info,trans) end subroutine psb_d_coo_csmm +function psb_d_coo_maxval(a) result(res) + use psb_error_mod + use psb_d_base_mat_mod, psb_protect_name => psb_d_coo_maxval + implicit none + class(psb_d_coo_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + + integer :: i,j,k,m,n, nnz, ir, jc, nc, info + character(len=20) :: name='d_coo_maxval' + logical, parameter :: debug=.false. + + + res = dzero + nnz = a%get_nzeros() + if (allocated(a%val)) then + nnz = min(nnz,size(a%val)) + res = maxval(abs(a%val(1:nnz))) + end if +end function psb_d_coo_maxval + function psb_d_coo_csnmi(a) result(res) use psb_error_mod use psb_d_base_mat_mod, psb_protect_name => psb_d_coo_csnmi diff --git a/base/serial/impl/psb_d_csc_impl.f90 b/base/serial/impl/psb_d_csc_impl.f90 index fc6cee620..1acc15b8f 100644 --- a/base/serial/impl/psb_d_csc_impl.f90 +++ b/base/serial/impl/psb_d_csc_impl.f90 @@ -1025,6 +1025,26 @@ contains end subroutine psb_d_csc_cssm +function psb_d_csc_maxval(a) result(res) + use psb_error_mod + use psb_d_csc_mat_mod, psb_protect_name => psb_d_csc_maxval + implicit none + class(psb_d_csc_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + + integer :: i,j,k,m,n, nnz, ir, jc, nc, info + character(len=20) :: name='d_csc_maxval' + logical, parameter :: debug=.false. + + + res = dzero + nnz = a%get_nzeros() + if (allocated(a%val)) then + nnz = min(nnz,size(a%val)) + res = maxval(abs(a%val(1:nnz))) + end if +end function psb_d_csc_maxval + function psb_d_csc_csnmi(a) result(res) use psb_error_mod use psb_d_csc_mat_mod, psb_protect_name => psb_d_csc_csnmi diff --git a/base/serial/impl/psb_d_csr_impl.f90 b/base/serial/impl/psb_d_csr_impl.f90 index 6e0b61f47..bcd75004e 100644 --- a/base/serial/impl/psb_d_csr_impl.f90 +++ b/base/serial/impl/psb_d_csr_impl.f90 @@ -1044,6 +1044,27 @@ contains end subroutine psb_d_csr_cssm + +function psb_d_csr_maxval(a) result(res) + use psb_error_mod + use psb_d_csr_mat_mod, psb_protect_name => psb_d_csr_maxval + implicit none + class(psb_d_csr_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + + integer :: i,j,k,m,n, nnz, ir, jc, nc, info + character(len=20) :: name='d_csr_maxval' + logical, parameter :: debug=.false. + + + res = dzero + nnz = a%get_nzeros() + if (allocated(a%val)) then + nnz = min(nnz,size(a%val)) + res = maxval(abs(a%val(1:nnz))) + end if +end function psb_d_csr_maxval + function psb_d_csr_csnmi(a) result(res) use psb_error_mod use psb_d_csr_mat_mod, psb_protect_name => psb_d_csr_csnmi diff --git a/base/serial/impl/psb_d_mat_impl.F90 b/base/serial/impl/psb_d_mat_impl.F90 index 1804495e6..4665a52d1 100644 --- a/base/serial/impl/psb_d_mat_impl.F90 +++ b/base/serial/impl/psb_d_mat_impl.F90 @@ -1836,6 +1836,57 @@ subroutine psb_d_csmv(alpha,a,x,beta,y,info,trans) end subroutine psb_d_csmv +subroutine psb_d_csmv_vect(alpha,a,x,beta,y,info,trans) + use psb_error_mod + use psb_d_vect_mod + use psb_d_mat_mod, psb_protect_name => psb_d_csmv_vect + implicit none + class(psb_dspmat_type), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta + type(psb_d_vect_type), intent(inout) :: x + type(psb_d_vect_type), intent(inout) :: y + integer, intent(out) :: info + character, optional, intent(in) :: trans + Integer :: err_act + character(len=20) :: name='psb_csmv' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + if (.not.allocated(a%a)) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(y%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + call a%a%csmm(alpha,x%v,beta,y%v,info,trans) + if (info /= psb_success_) 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 psb_d_csmv_vect + + subroutine psb_d_cssm(alpha,a,x,beta,y,info,trans,scale,d) use psb_error_mod use psb_d_mat_mod, psb_protect_name => psb_d_cssm @@ -1917,6 +1968,99 @@ subroutine psb_d_cssv(alpha,a,x,beta,y,info,trans,scale,d) end subroutine psb_d_cssv +subroutine psb_d_cssv_vect(alpha,a,x,beta,y,info,trans,scale,d) + use psb_error_mod + use psb_d_vect_mod + use psb_d_mat_mod, psb_protect_name => psb_d_cssv_vect + implicit none + class(psb_dspmat_type), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta + type(psb_d_vect_type), intent(inout) :: x + type(psb_d_vect_type), intent(inout) :: y + integer, intent(out) :: info + character, optional, intent(in) :: trans, scale + type(psb_d_vect_type), optional, intent(inout) :: d + Integer :: err_act + character(len=20) :: name='psb_cssv' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + if (.not.allocated(a%a)) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(y%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (present(d)) then + if (.not.allocated(d%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + call a%a%cssm(alpha,x%v,beta,y%v,info,trans,scale,d%v) + else + call a%a%cssm(alpha,x%v,beta,y%v,info,trans,scale) + end if + + if (info /= psb_success_) 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 psb_d_cssv_vect + +function psb_d_maxval(a) result(res) + use psb_d_mat_mod, psb_protect_name => psb_d_maxval + use psb_error_mod + use psb_const_mod + implicit none + class(psb_dspmat_type), intent(in) :: a + real(psb_dpk_) :: res + + + Integer :: err_act, info + character(len=20) :: name='maxval' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + info = psb_success_ + if (.not.allocated(a%a)) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + res = a%a%maxval() + return + +9999 continue + + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + +end function psb_d_maxval function psb_d_csnmi(a) result(res) use psb_d_mat_mod, psb_protect_name => psb_d_csnmi diff --git a/base/serial/impl/psb_s_base_mat_impl.f90 b/base/serial/impl/psb_s_base_mat_impl.f90 index 7f8d12f8e..ca6391e15 100644 --- a/base/serial/impl/psb_s_base_mat_impl.f90 +++ b/base/serial/impl/psb_s_base_mat_impl.f90 @@ -1036,6 +1036,34 @@ subroutine psb_s_base_scal(d,a,info) end subroutine psb_s_base_scal +function psb_s_base_maxval(a) result(res) + use psb_error_mod + use psb_const_mod + use psb_s_base_mat_mod, psb_protect_name => psb_s_base_maxval + + implicit none + class(psb_s_base_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + + Integer :: err_act, info + character(len=20) :: name='maxval' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + ! This is the base version. If we get here + ! it means the derived class is incomplete, + ! so we throw an error. + info = psb_err_missing_override_method_ + call psb_errpush(info,name,a_err=a%get_fmt()) + + if (err_act /= psb_act_ret_) then + call psb_error() + end if + res = -sone + + return + +end function psb_s_base_maxval function psb_s_base_csnmi(a) result(res) use psb_error_mod @@ -1066,6 +1094,140 @@ function psb_s_base_csnmi(a) result(res) end function psb_s_base_csnmi + +function psb_s_base_csnm1(a) result(res) + use psb_error_mod + use psb_const_mod + use psb_s_base_mat_mod, psb_protect_name => psb_s_base_csnm1 + + implicit none + class(psb_s_base_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + + Integer :: err_act, info + character(len=20) :: name='csnm1' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + ! This is the base version. If we get here + ! it means the derived class is incomplete, + ! so we throw an error. + info = psb_err_missing_override_method_ + call psb_errpush(info,name,a_err=a%get_fmt()) + + if (err_act /= psb_act_ret_) then + call psb_error() + end if + res = -sone + + return + +end function psb_s_base_csnm1 + +subroutine psb_s_base_rowsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_s_base_mat_mod, psb_protect_name => psb_s_base_rowsum + class(psb_s_base_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + + Integer :: err_act, info + character(len=20) :: name='rowsum' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + ! This is the base version. If we get here + ! it means the derived class is incomplete, + ! so we throw an error. + info = psb_err_missing_override_method_ + call psb_errpush(info,name,a_err=a%get_fmt()) + + if (err_act /= psb_act_ret_) then + call psb_error() + end if + + return + +end subroutine psb_s_base_rowsum + +subroutine psb_s_base_arwsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_s_base_mat_mod, psb_protect_name => psb_s_base_arwsum + class(psb_s_base_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + + Integer :: err_act, info + character(len=20) :: name='arwsum' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + ! This is the base version. If we get here + ! it means the derived class is incomplete, + ! so we throw an error. + info = psb_err_missing_override_method_ + call psb_errpush(info,name,a_err=a%get_fmt()) + + if (err_act /= psb_act_ret_) then + call psb_error() + end if + + return + +end subroutine psb_s_base_arwsum + +subroutine psb_s_base_colsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_s_base_mat_mod, psb_protect_name => psb_s_base_colsum + class(psb_s_base_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + + Integer :: err_act, info + character(len=20) :: name='colsum' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + ! This is the base version. If we get here + ! it means the derived class is incomplete, + ! so we throw an error. + info = psb_err_missing_override_method_ + call psb_errpush(info,name,a_err=a%get_fmt()) + + if (err_act /= psb_act_ret_) then + call psb_error() + end if + + return + +end subroutine psb_s_base_colsum + +subroutine psb_s_base_aclsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_s_base_mat_mod, psb_protect_name => psb_s_base_aclsum + class(psb_s_base_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + + Integer :: err_act, info + character(len=20) :: name='aclsum' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + ! This is the base version. If we get here + ! it means the derived class is incomplete, + ! so we throw an error. + info = psb_err_missing_override_method_ + call psb_errpush(info,name,a_err=a%get_fmt()) + + if (err_act /= psb_act_ret_) then + call psb_error() + end if + + return + +end subroutine psb_s_base_aclsum + subroutine psb_s_base_get_diag(a,d,info) use psb_error_mod use psb_const_mod @@ -1097,4 +1259,222 @@ end subroutine psb_s_base_get_diag +! == ================================== +! +! +! +! Computational routines for S_VECT +! variables. If the actual data type is +! a "normal" one, these are sufficient. +! +! +! +! +! == ================================== + + +subroutine psb_s_base_vect_mv(alpha,a,x,beta,y,info,trans) + use psb_error_mod + use psb_const_mod + use psb_s_base_mat_mod, psb_protect_name => psb_s_base_vect_mv + implicit none + class(psb_s_base_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta + class(psb_s_base_vect_type), intent(inout) :: x + class(psb_s_base_vect_type), intent(inout) :: y + integer, intent(out) :: info + character, optional, intent(in) :: trans + + ! For the time being we just throw everything back + ! onto the normal routines. + call x%sync() + call y%sync() + call a%csmm(alpha,x%v,beta,y%v,info,trans) + +end subroutine psb_s_base_vect_mv + +subroutine psb_s_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d) + use psb_s_base_mat_mod, psb_protect_name => psb_s_base_vect_cssv + use psb_s_base_vect_mod + use psb_error_mod + use psb_string_mod + implicit none + class(psb_s_base_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta + class(psb_s_base_vect_type), intent(inout) :: x,y + integer, intent(out) :: info + character, optional, intent(in) :: trans, scale + class(psb_s_base_vect_type), intent(inout),optional :: d + + real(psb_spk_), allocatable :: tmp(:) + class(psb_s_base_vect_type), allocatable :: tmpv + Integer :: err_act, nar,nac,nc, i + character(len=1) :: scale_ + character(len=20) :: name='s_cssm' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + nar = a%get_nrows() + nac = a%get_ncols() + nc = 1 + if (x%get_nrows() < nac) then + info = 36 + call psb_errpush(info,name,i_err=(/3,nac,0,0,0/)) + goto 9999 + end if + if (y%get_nrows() < nar) then + info = 36 + call psb_errpush(info,name,i_err=(/3,nar,0,0,0/)) + goto 9999 + end if + + if (.not. (a%is_triangle())) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + end if + + call x%sync() + call y%sync() + if (present(d)) then + call d%sync() + if (present(scale)) then + scale_ = scale + else + scale_ = 'L' + end if + + if (psb_toupper(scale_) == 'R') then + if (d%get_nrows() < nac) then + info = 36 + call psb_errpush(info,name,i_err=(/9,nac,0,0,0/)) + goto 9999 + end if + + allocate(tmpv, mold=y,stat=info) + ! allocate(tmp(nac),stat=info) + if (info /= psb_success_) info = psb_err_alloc_dealloc_ + if (info == psb_success_) call tmpv%mlt(sone,d%v(1:nac),x,szero,info) + if (info == psb_success_)& + & call a%inner_cssm(alpha,tmpv,beta,y,info,trans) + + if (info == psb_success_) then + call tmpv%free(info) + if (info == psb_success_) deallocate(tmpv,stat=info) + if (info /= psb_success_) info = psb_err_alloc_dealloc_ + end if + + else if (psb_toupper(scale_) == 'L') then + if (d%get_nrows() < nar) then + info = 36 + call psb_errpush(info,name,i_err=(/9,nar,0,0,0/)) + goto 9999 + end if + + if (beta == szero) then + call a%inner_cssm(alpha,x,szero,y,info,trans) + if (info == psb_success_) call y%mlt(d%v(1:nar),info) +!!$ if (info == psb_success_) call inner_vscal1(nar,d,y) + else + ! allocate(tmp(nar),stat=info) + allocate(tmpv, mold=y,stat=info) + if (info /= psb_success_) info = psb_err_alloc_dealloc_ + if (info == psb_success_)& + & call a%inner_cssm(alpha,x,szero,tmpv,info,trans) + + if (info == psb_success_) call tmpv%mlt(d%v(1:nar),info) + if (info == psb_success_)& + & call y%axpby(nar,sone,tmpv,beta,info) + if (info == psb_success_) then + call tmpv%free(info) + if (info == psb_success_) deallocate(tmpv,stat=info) + if (info /= psb_success_) info = psb_err_alloc_dealloc_ + end if + end if + + else + info = 31 + call psb_errpush(info,name,i_err=(/8,0,0,0,0/),a_err=scale_) + goto 9999 + end if + else + ! Scale is ignored in this case + call a%inner_cssm(alpha,x,beta,y,info,trans) + end if + + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='inner_cssm') + 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 psb_s_base_vect_cssv + + +subroutine psb_s_base_inner_vect_sv(alpha,a,x,beta,y,info,trans) + use psb_s_base_mat_mod, psb_protect_name => psb_s_base_inner_vect_sv + use psb_error_mod + use psb_string_mod + use psb_s_base_vect_mod + implicit none + class(psb_s_base_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta + class(psb_s_base_vect_type), intent(inout) :: x, y + integer, intent(out) :: info + character, optional, intent(in) :: trans + + Integer :: err_act + character(len=20) :: name='s_base_inner_vect_sv' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + ! This is the base version. If we get here + ! it means the derived class is incomplete, + ! so we throw an error. + info = psb_success_ + + call a%inner_cssm(alpha,x%v,beta,y%v,info,trans) + + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='inner_cssm') + 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 psb_s_base_inner_vect_sv diff --git a/base/serial/impl/psb_s_coo_impl.f90 b/base/serial/impl/psb_s_coo_impl.f90 index 42e9bfdcb..eb740b715 100644 --- a/base/serial/impl/psb_s_coo_impl.f90 +++ b/base/serial/impl/psb_s_coo_impl.f90 @@ -1365,6 +1365,26 @@ subroutine psb_s_coo_csmm(alpha,a,x,beta,y,info,trans) end subroutine psb_s_coo_csmm +function psb_s_coo_maxval(a) result(res) + use psb_error_mod + use psb_s_base_mat_mod, psb_protect_name => psb_s_coo_maxval + implicit none + class(psb_s_coo_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + + integer :: i,j,k,m,n, nnz, ir, jc, nc, info + character(len=20) :: name='d_coo_maxval' + logical, parameter :: debug=.false. + + + res = szero + nnz = a%get_nzeros() + if (allocated(a%val)) then + nnz = min(nnz,size(a%val)) + res = maxval(abs(a%val(1:nnz))) + end if +end function psb_s_coo_maxval + function psb_s_coo_csnmi(a) result(res) use psb_error_mod use psb_s_base_mat_mod, psb_protect_name => psb_s_coo_csnmi @@ -1372,8 +1392,9 @@ function psb_s_coo_csnmi(a) result(res) class(psb_s_coo_sparse_mat), intent(in) :: a real(psb_spk_) :: res - integer :: i,j,k,m,n, nnz, ir, jc, nc + integer :: i,j,k,m,n, nnz, ir, jc, nc, info real(psb_spk_) :: acc + real(psb_spk_), allocatable :: vt(:) logical :: tra Integer :: err_act character(len=20) :: name='s_base_csnmi' @@ -1382,23 +1403,269 @@ function psb_s_coo_csnmi(a) result(res) res = szero nnz = a%get_nzeros() - i = 1 - j = i - do while (i<=nnz) - do while ((a%ia(j) == a%ia(i)).and. (j <= nnz)) - j = j+1 - enddo - acc = szero - do k=i, j-1 - acc = acc + abs(a%val(k)) + if (a%is_sorted()) then + i = 1 + j = i + res = szero + do while (i<=nnz) + do while ((a%ia(j) == a%ia(i)).and. (j <= nnz)) + j = j+1 + enddo + acc = szero + do k=i, j-1 + acc = acc + abs(a%val(k)) + end do + res = max(res,acc) + i = j end do - res = max(res,acc) - i = j - end do + else + m = a%get_nrows() + allocate(vt(m),stat=info) + if (info /= 0) return + vt(:) = szero + do j=1, nnz + i = a%ia(j) + vt(i) = vt(i) + abs(a%val(j)) + end do + res = maxval(vt(1:m)) + deallocate(vt,stat=info) + end if end function psb_s_coo_csnmi +function psb_s_coo_csnm1(a) result(res) + use psb_error_mod + use psb_const_mod + use psb_s_base_mat_mod, psb_protect_name => psb_s_coo_csnm1 + + implicit none + class(psb_s_coo_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + + integer :: i,j,k,m,n, nnz, ir, jc, nc, info + real(psb_spk_) :: acc + real(psb_spk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act + character(len=20) :: name='d_coo_csnm1' + logical, parameter :: debug=.false. + + + res = -sone + nnz = a%get_nzeros() + n = a%get_ncols() + allocate(vt(n),stat=info) + if (info /= 0) return + vt(:) = szero + do j=1, nnz + i = a%ja(j) + vt(i) = vt(i) + abs(a%val(j)) + end do + res = maxval(vt(1:n)) + deallocate(vt,stat=info) + + return + +end function psb_s_coo_csnm1 + +subroutine psb_s_coo_rowsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_s_base_mat_mod, psb_protect_name => psb_s_coo_rowsum + class(psb_s_coo_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + real(psb_spk_) :: acc + real(psb_spk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='rowsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + m = a%get_nrows() + if (size(d) < m) then + info=psb_err_input_asize_small_i_ + int_err(1) = 1 + int_err(2) = size(d) + int_err(3) = m + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + d = szero + nnz = a%get_nzeros() + do j=1, nnz + i = a%ia(j) + d(i) = d(i) + a%val(j) + end do + + return + 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 psb_s_coo_rowsum + +subroutine psb_s_coo_arwsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_s_base_mat_mod, psb_protect_name => psb_s_coo_arwsum + class(psb_s_coo_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + real(psb_spk_) :: acc + real(psb_spk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='rowsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + m = a%get_nrows() + if (size(d) < m) then + info=psb_err_input_asize_small_i_ + int_err(1) = 1 + int_err(2) = size(d) + int_err(3) = m + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + d = szero + nnz = a%get_nzeros() + do j=1, nnz + i = a%ia(j) + d(i) = d(i) + abs(a%val(j)) + end do + + return + 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 psb_s_coo_arwsum + +subroutine psb_s_coo_colsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_s_base_mat_mod, psb_protect_name => psb_s_coo_colsum + class(psb_s_coo_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + real(psb_spk_) :: acc + real(psb_spk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='colsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + n = a%get_ncols() + if (size(d) < n) then + info=psb_err_input_asize_small_i_ + int_err(1) = 1 + int_err(2) = size(d) + int_err(3) = n + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + d = szero + nnz = a%get_nzeros() + do j=1, nnz + k = a%ja(j) + d(k) = d(k) + a%val(j) + end do + + return + 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 psb_s_coo_colsum + +subroutine psb_s_coo_aclsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_s_base_mat_mod, psb_protect_name => psb_s_coo_aclsum + class(psb_s_coo_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + real(psb_spk_) :: acc + real(psb_spk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='aclsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + n = a%get_ncols() + if (size(d) < n) then + info=psb_err_input_asize_small_i_ + int_err(1) = 1 + int_err(2) = size(d) + int_err(3) = n + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + d = szero + nnz = a%get_nzeros() + do j=1, nnz + k = a%ja(j) + d(k) = d(k) + abs(a%val(j)) + end do + + return + 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 psb_s_coo_aclsum + + ! == ================================== ! diff --git a/base/serial/impl/psb_s_csc_impl.f90 b/base/serial/impl/psb_s_csc_impl.f90 index d2a621fa2..f50843e9f 100644 --- a/base/serial/impl/psb_s_csc_impl.f90 +++ b/base/serial/impl/psb_s_csc_impl.f90 @@ -71,10 +71,10 @@ subroutine psb_s_csc_csmv(alpha,a,x,beta,y,info,trans) end if - if (alpha == dzero) then - if (beta == dzero) then + if (alpha == szero) then + if (beta == szero) then do i = 1, m - y(i) = dzero + y(i) = szero enddo else do i = 1, m @@ -86,21 +86,21 @@ subroutine psb_s_csc_csmv(alpha,a,x,beta,y,info,trans) if (tra) then - if (beta == dzero) then + if (beta == szero) then - if (alpha == done) then + if (alpha == sone) then do i=1,m - acc = dzero + acc = szero 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 + else if (alpha == -sone) then do i=1,m - acc = dzero + acc = szero do j=a%icp(i), a%icp(i+1)-1 acc = acc + a%val(j) * x(a%ia(j)) enddo @@ -110,7 +110,7 @@ subroutine psb_s_csc_csmv(alpha,a,x,beta,y,info,trans) else do i=1,m - acc = dzero + acc = szero do j=a%icp(i), a%icp(i+1)-1 acc = acc + a%val(j) * x(a%ia(j)) enddo @@ -120,21 +120,21 @@ subroutine psb_s_csc_csmv(alpha,a,x,beta,y,info,trans) end if - else if (beta == done) then + else if (beta == sone) then - if (alpha == done) then + if (alpha == sone) then do i=1,m - acc = dzero + acc = szero 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 + else if (alpha == -sone) then do i=1,m - acc = dzero + acc = szero do j=a%icp(i), a%icp(i+1)-1 acc = acc + a%val(j) * x(a%ia(j)) enddo @@ -144,7 +144,7 @@ subroutine psb_s_csc_csmv(alpha,a,x,beta,y,info,trans) else do i=1,m - acc = dzero + acc = szero do j=a%icp(i), a%icp(i+1)-1 acc = acc + a%val(j) * x(a%ia(j)) enddo @@ -153,21 +153,21 @@ subroutine psb_s_csc_csmv(alpha,a,x,beta,y,info,trans) end if - else if (beta == -done) then + else if (beta == -sone) then - if (alpha == done) then + if (alpha == sone) then do i=1,m - acc = dzero + acc = szero 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 + else if (alpha == -sone) then do i=1,m - acc = dzero + acc = szero do j=a%icp(i), a%icp(i+1)-1 acc = acc + a%val(j) * x(a%ia(j)) enddo @@ -177,7 +177,7 @@ subroutine psb_s_csc_csmv(alpha,a,x,beta,y,info,trans) else do i=1,m - acc = dzero + acc = szero do j=a%icp(i), a%icp(i+1)-1 acc = acc + a%val(j) * x(a%ia(j)) enddo @@ -188,19 +188,19 @@ subroutine psb_s_csc_csmv(alpha,a,x,beta,y,info,trans) else - if (alpha == done) then + if (alpha == sone) then do i=1,m - acc = dzero + acc = szero 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 + else if (alpha == -sone) then do i=1,m - acc = dzero + acc = szero do j=a%icp(i), a%icp(i+1)-1 acc = acc + a%val(j) * x(a%ia(j)) enddo @@ -210,7 +210,7 @@ subroutine psb_s_csc_csmv(alpha,a,x,beta,y,info,trans) else do i=1,m - acc = dzero + acc = szero do j=a%icp(i), a%icp(i+1)-1 acc = acc + a%val(j) * x(a%ia(j)) enddo @@ -223,13 +223,13 @@ subroutine psb_s_csc_csmv(alpha,a,x,beta,y,info,trans) else if (.not.tra) then - if (beta == dzero) then + if (beta == szero) then do i=1, m - y(i) = dzero + y(i) = szero end do - else if (beta == done) then + else if (beta == sone) then ! Do nothing - else if (beta == -done) then + else if (beta == -sone) then do i=1, m y(i) = -y(i) end do @@ -239,7 +239,7 @@ subroutine psb_s_csc_csmv(alpha,a,x,beta,y,info,trans) end do end if - if (alpha == done) then + if (alpha == sone) then do i=1,n do j=a%icp(i), a%icp(i+1)-1 @@ -248,7 +248,7 @@ subroutine psb_s_csc_csmv(alpha,a,x,beta,y,info,trans) end do enddo - else if (alpha == -done) then + else if (alpha == -sone) then do i=1,n do j=a%icp(i), a%icp(i+1)-1 @@ -354,10 +354,10 @@ subroutine psb_s_csc_csmm(alpha,a,x,beta,y,info,trans) goto 9999 end if - if (alpha == dzero) then - if (beta == dzero) then + if (alpha == szero) then + if (beta == szero) then do i = 1, m - y(i,:) = dzero + y(i,:) = szero enddo else do i = 1, m @@ -369,21 +369,21 @@ subroutine psb_s_csc_csmm(alpha,a,x,beta,y,info,trans) if (tra) then - if (beta == dzero) then + if (beta == szero) then - if (alpha == done) then + if (alpha == sone) then do i=1,m - acc = dzero + acc = szero 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 + else if (alpha == -sone) then do i=1,m - acc = dzero + acc = szero do j=a%icp(i), a%icp(i+1)-1 acc = acc + a%val(j) * x(a%ia(j),:) enddo @@ -393,7 +393,7 @@ subroutine psb_s_csc_csmm(alpha,a,x,beta,y,info,trans) else do i=1,m - acc = dzero + acc = szero do j=a%icp(i), a%icp(i+1)-1 acc = acc + a%val(j) * x(a%ia(j),:) enddo @@ -403,21 +403,21 @@ subroutine psb_s_csc_csmm(alpha,a,x,beta,y,info,trans) end if - else if (beta == done) then + else if (beta == sone) then - if (alpha == done) then + if (alpha == sone) then do i=1,m - acc = dzero + acc = szero 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 + else if (alpha == -sone) then do i=1,m - acc = dzero + acc = szero do j=a%icp(i), a%icp(i+1)-1 acc = acc + a%val(j) * x(a%ia(j),:) enddo @@ -427,7 +427,7 @@ subroutine psb_s_csc_csmm(alpha,a,x,beta,y,info,trans) else do i=1,m - acc = dzero + acc = szero do j=a%icp(i), a%icp(i+1)-1 acc = acc + a%val(j) * x(a%ia(j),:) enddo @@ -436,21 +436,21 @@ subroutine psb_s_csc_csmm(alpha,a,x,beta,y,info,trans) end if - else if (beta == -done) then + else if (beta == -sone) then - if (alpha == done) then + if (alpha == sone) then do i=1,m - acc = dzero + acc = szero 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 + else if (alpha == -sone) then do i=1,m - acc = dzero + acc = szero do j=a%icp(i), a%icp(i+1)-1 acc = acc + a%val(j) * x(a%ia(j),:) enddo @@ -460,7 +460,7 @@ subroutine psb_s_csc_csmm(alpha,a,x,beta,y,info,trans) else do i=1,m - acc = dzero + acc = szero do j=a%icp(i), a%icp(i+1)-1 acc = acc + a%val(j) * x(a%ia(j),:) enddo @@ -471,19 +471,19 @@ subroutine psb_s_csc_csmm(alpha,a,x,beta,y,info,trans) else - if (alpha == done) then + if (alpha == sone) then do i=1,m - acc = dzero + acc = szero 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 + else if (alpha == -sone) then do i=1,m - acc = dzero + acc = szero do j=a%icp(i), a%icp(i+1)-1 acc = acc + a%val(j) * x(a%ia(j),:) enddo @@ -493,7 +493,7 @@ subroutine psb_s_csc_csmm(alpha,a,x,beta,y,info,trans) else do i=1,m - acc = dzero + acc = szero do j=a%icp(i), a%icp(i+1)-1 acc = acc + a%val(j) * x(a%ia(j),:) enddo @@ -506,13 +506,13 @@ subroutine psb_s_csc_csmm(alpha,a,x,beta,y,info,trans) else if (.not.tra) then - if (beta == dzero) then + if (beta == szero) then do i=1, m - y(i,:) = dzero + y(i,:) = szero end do - else if (beta == done) then + else if (beta == sone) then ! Do nothing - else if (beta == -done) then + else if (beta == -sone) then do i=1, m y(i,:) = -y(i,:) end do @@ -522,7 +522,7 @@ subroutine psb_s_csc_csmm(alpha,a,x,beta,y,info,trans) end do end if - if (alpha == done) then + if (alpha == sone) then do i=1,n do j=a%icp(i), a%icp(i+1)-1 @@ -531,7 +531,7 @@ subroutine psb_s_csc_csmm(alpha,a,x,beta,y,info,trans) end do enddo - else if (alpha == -done) then + else if (alpha == -sone) then do i=1,n do j=a%icp(i), a%icp(i+1)-1 @@ -629,10 +629,10 @@ subroutine psb_s_csc_cssv(alpha,a,x,beta,y,info,trans) - if (alpha == dzero) then - if (beta == dzero) then + if (alpha == szero) then + if (beta == szero) then do i = 1, m - y(i) = dzero + y(i) = szero enddo else do i = 1, m @@ -642,12 +642,12 @@ subroutine psb_s_csc_cssv(alpha,a,x,beta,y,info,trans) return end if - if (beta == dzero) then + if (beta == szero) 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 + if (alpha == sone) then ! do nothing - else if (alpha == -done) then + else if (alpha == -sone) then do i = 1, m y(i) = -y(i) end do @@ -699,7 +699,7 @@ contains if (lower) then if (unit) then do i=n, 1, -1 - acc = dzero + acc = szero do j=icp(i), icp(i+1)-1 acc = acc + val(j)*y(ia(j)) end do @@ -707,7 +707,7 @@ contains end do else if (.not.unit) then do i=n, 1, -1 - acc = dzero + acc = szero do j=icp(i)+1, icp(i+1)-1 acc = acc + val(j)*y(ia(j)) end do @@ -719,7 +719,7 @@ contains if (unit) then do i=1, n - acc = dzero + acc = szero do j=icp(i), icp(i+1)-1 acc = acc + val(j)*y(ia(j)) end do @@ -727,7 +727,7 @@ contains end do else if (.not.unit) then do i=1, n - acc = dzero + acc = szero do j=icp(i), icp(i+1)-2 acc = acc + val(j)*y(ia(j)) end do @@ -853,10 +853,10 @@ subroutine psb_s_csc_cssm(alpha,a,x,beta,y,info,trans) end if - if (alpha == dzero) then - if (beta == dzero) then + if (alpha == szero) then + if (beta == szero) then do i = 1, m - y(i,:) = dzero + y(i,:) = szero enddo else do i = 1, m @@ -866,7 +866,7 @@ subroutine psb_s_csc_cssm(alpha,a,x,beta,y,info,trans) return end if - if (beta == dzero) then + if (beta == szero) 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 @@ -934,7 +934,7 @@ contains if (lower) then if (unit) then do i=nr, 1, -1 - acc = dzero + acc = szero do j=icp(i), icp(i+1)-1 acc = acc + val(j)*y(ia(j),1:nc) end do @@ -942,7 +942,7 @@ contains end do else if (.not.unit) then do i=nr, 1, -1 - acc = dzero + acc = szero do j=icp(i)+1, icp(i+1)-1 acc = acc + val(j)*y(ia(j),1:nc) end do @@ -954,7 +954,7 @@ contains if (unit) then do i=1, nr - acc = dzero + acc = szero do j=icp(i), icp(i+1)-1 acc = acc + val(j)*y(ia(j),1:nc) end do @@ -962,7 +962,7 @@ contains end do else if (.not.unit) then do i=1, nr - acc = dzero + acc = szero do j=icp(i), icp(i+1)-2 acc = acc + val(j)*y(ia(j),1:nc) end do @@ -1026,6 +1026,26 @@ contains end subroutine psb_s_csc_cssm +function psb_s_csc_maxval(a) result(res) + use psb_error_mod + use psb_s_csc_mat_mod, psb_protect_name => psb_s_csc_maxval + implicit none + class(psb_s_csc_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + + integer :: i,j,k,m,n, nnz, ir, jc, nc, info + character(len=20) :: name='d_csc_maxval' + logical, parameter :: debug=.false. + + + res = szero + nnz = a%get_nzeros() + if (allocated(a%val)) then + nnz = min(nnz,size(a%val)) + res = maxval(abs(a%val(1:nnz))) + end if +end function psb_s_csc_maxval + function psb_s_csc_csnmi(a) result(res) use psb_error_mod use psb_s_csc_mat_mod, psb_protect_name => psb_s_csc_csnmi @@ -1041,14 +1061,14 @@ function psb_s_csc_csnmi(a) result(res) logical, parameter :: debug=.false. - res = dzero + res = szero nr = a%get_nrows() nc = a%get_ncols() allocate(acc(nr),stat=info) if (info /= psb_success_) then return end if - acc(:) = dzero + acc(:) = szero 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)) @@ -1061,6 +1081,240 @@ function psb_s_csc_csnmi(a) result(res) end function psb_s_csc_csnmi +function psb_s_csc_csnm1(a) result(res) + use psb_error_mod + use psb_const_mod + use psb_s_csc_mat_mod, psb_protect_name => psb_s_csc_csnm1 + + implicit none + class(psb_s_csc_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + + integer :: i,j,k,m,n, nnz, ir, jc, nc, info + real(psb_spk_) :: acc + real(psb_spk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act + character(len=20) :: name='d_csc_csnm1' + logical, parameter :: debug=.false. + + + res = szero + m = a%get_nrows() + n = a%get_ncols() + do j=1, n + acc = szero + do k=a%icp(j),a%icp(j+1)-1 + acc = acc + abs(a%val(k)) + end do + res = max(res,acc) + end do + + return + +end function psb_s_csc_csnm1 + +subroutine psb_s_csc_colsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_s_csc_mat_mod, psb_protect_name => psb_s_csc_colsum + class(psb_s_csc_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + real(psb_spk_) :: acc + real(psb_spk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='colsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + m = a%get_ncols() + if (size(d) < m) then + info=psb_err_input_asize_small_i_ + int_err(1) = 1 + int_err(2) = size(d) + int_err(3) = m + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + do i = 1, a%get_ncols() + d(i) = szero + do j=a%icp(i),a%icp(i+1)-1 + d(i) = d(i) + (a%val(j)) + end do + end do + + return + 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 psb_s_csc_colsum + +subroutine psb_s_csc_aclsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_s_csc_mat_mod, psb_protect_name => psb_s_csc_aclsum + class(psb_s_csc_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + real(psb_spk_) :: acc + real(psb_spk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='colsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + m = a%get_ncols() + if (size(d) < m) then + info=psb_err_input_asize_small_i_ + int_err(1) = 1 + int_err(2) = size(d) + int_err(3) = m + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + + do i = 1, a%get_ncols() + d(i) = szero + do j=a%icp(i),a%icp(i+1)-1 + d(i) = d(i) + abs(a%val(j)) + end do + 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 psb_s_csc_aclsum + +subroutine psb_s_csc_rowsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_s_csc_mat_mod, psb_protect_name => psb_s_csc_rowsum + class(psb_s_csc_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + real(psb_spk_) :: acc + real(psb_spk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='rowsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + m = a%get_ncols() + n = a%get_nrows() + if (size(d) < n) then + info=psb_err_input_asize_small_i_ + int_err(1) = 1 + int_err(2) = size(d) + int_err(3) = n + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + d = szero + + do i=1, m + do j=a%icp(i),a%icp(i+1)-1 + k = a%ia(j) + d(k) = d(k) + (a%val(k)) + end do + end do + + return + 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 psb_s_csc_rowsum + +subroutine psb_s_csc_arwsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_s_csc_mat_mod, psb_protect_name => psb_s_csc_arwsum + class(psb_s_csc_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + real(psb_spk_) :: acc + real(psb_spk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='arwsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + m = a%get_ncols() + n = a%get_nrows() + if (size(d) < n) then + info=psb_err_input_asize_small_i_ + int_err(1) = 1 + int_err(2) = size(d) + int_err(3) = n + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + d = szero + + do i=1, m + do j=a%icp(i),a%icp(i+1)-1 + k = a%ia(j) + d(k) = d(k) + abs(a%val(k)) + end do + end do + + return + 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 psb_s_csc_arwsum subroutine psb_s_csc_get_diag(a,d,info) use psb_error_mod @@ -2398,7 +2652,7 @@ subroutine psb_s_csc_reinit(a,clear) ! do nothing return else if (a%is_asb()) then - if (clear_) a%val(:) = dzero + if (clear_) a%val(:) = szero call a%set_upd() else info = psb_err_invalid_mat_state_ diff --git a/base/serial/impl/psb_s_csr_impl.f90 b/base/serial/impl/psb_s_csr_impl.f90 index 1110d8a7e..a76eb2f7d 100644 --- a/base/serial/impl/psb_s_csr_impl.f90 +++ b/base/serial/impl/psb_s_csr_impl.f90 @@ -98,10 +98,10 @@ contains integer :: i,j,k, ir, jc real(psb_spk_) :: acc - if (alpha == dzero) then - if (beta == dzero) then + if (alpha == szero) then + if (beta == szero) then do i = 1, m - y(i) = dzero + y(i) = szero enddo else do i = 1, m @@ -114,21 +114,21 @@ contains if (.not.tra) then - if (beta == dzero) then + if (beta == szero) then - if (alpha == done) then + if (alpha == sone) then do i=1,m - acc = dzero + acc = szero do j=irp(i), irp(i+1)-1 acc = acc + val(j) * x(ja(j)) enddo y(i) = acc end do - else if (alpha == -done) then + else if (alpha == -sone) then do i=1,m - acc = dzero + acc = szero do j=irp(i), irp(i+1)-1 acc = acc - val(j) * x(ja(j)) enddo @@ -138,7 +138,7 @@ contains else do i=1,m - acc = dzero + acc = szero do j=irp(i), irp(i+1)-1 acc = acc + val(j) * x(ja(j)) enddo @@ -148,18 +148,18 @@ contains end if - else if (beta == done) then + else if (beta == sone) then - if (alpha == done) then + if (alpha == sone) then do i=1,m - acc = dzero + acc = szero do j=irp(i), irp(i+1)-1 acc = acc + val(j) * x(ja(j)) enddo y(i) = y(i) + acc end do - else if (alpha == -done) then + else if (alpha == -sone) then do i=1,m acc = y(i) @@ -172,7 +172,7 @@ contains else do i=1,m - acc = dzero + acc = szero do j=irp(i), irp(i+1)-1 acc = acc + val(j) * x(ja(j)) enddo @@ -181,9 +181,9 @@ contains end if - else if (beta == -done) then + else if (beta == -sone) then - if (alpha == done) then + if (alpha == sone) then do i=1,m acc = -y(i) do j=irp(i), irp(i+1)-1 @@ -192,7 +192,7 @@ contains y(i) = acc end do - else if (alpha == -done) then + else if (alpha == -sone) then do i=1,m acc = y(i) @@ -205,7 +205,7 @@ contains else do i=1,m - acc = dzero + acc = szero do j=irp(i), irp(i+1)-1 acc = acc + val(j) * x(ja(j)) enddo @@ -216,19 +216,19 @@ contains else - if (alpha == done) then + if (alpha == sone) then do i=1,m - acc = dzero + acc = szero do j=irp(i), irp(i+1)-1 acc = acc + val(j) * x(ja(j)) enddo y(i) = beta*y(i) + acc end do - else if (alpha == -done) then + else if (alpha == -sone) then do i=1,m - acc = dzero + acc = szero do j=irp(i), irp(i+1)-1 acc = acc + val(j) * x(ja(j)) enddo @@ -238,7 +238,7 @@ contains else do i=1,m - acc = dzero + acc = szero do j=irp(i), irp(i+1)-1 acc = acc + val(j) * x(ja(j)) enddo @@ -251,13 +251,13 @@ contains else if (tra) then - if (beta == dzero) then + if (beta == szero) then do i=1, m - y(i) = dzero + y(i) = szero end do - else if (beta == done) then + else if (beta == sone) then ! Do nothing - else if (beta == -done) then + else if (beta == -sone) then do i=1, m y(i) = -y(i) end do @@ -267,7 +267,7 @@ contains end do end if - if (alpha == done) then + if (alpha == sone) then do i=1,n do j=irp(i), irp(i+1)-1 @@ -276,7 +276,7 @@ contains end do enddo - else if (alpha == -done) then + else if (alpha == -sone) then do i=1,n do j=irp(i), irp(i+1)-1 @@ -402,10 +402,10 @@ contains integer :: i,j,k, ir, jc - if (alpha == dzero) then - if (beta == dzero) then + if (alpha == szero) then + if (beta == szero) then do i = 1, m - y(i,1:nc) = dzero + y(i,1:nc) = szero enddo else do i = 1, m @@ -417,21 +417,21 @@ contains if (.not.tra) then - if (beta == dzero) then + if (beta == szero) then - if (alpha == done) then + if (alpha == sone) then do i=1,m - acc(1:nc) = dzero + acc(1:nc) = szero do j=irp(i), irp(i+1)-1 acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc) enddo y(i,1:nc) = acc(1:nc) end do - else if (alpha == -done) then + else if (alpha == -sone) then do i=1,m - acc(1:nc) = dzero + acc(1:nc) = szero do j=irp(i), irp(i+1)-1 acc(1:nc) = acc(1:nc) - val(j) * x(ja(j),1:nc) enddo @@ -441,7 +441,7 @@ contains else do i=1,m - acc(1:nc) = dzero + acc(1:nc) = szero do j=irp(i), irp(i+1)-1 acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc) enddo @@ -451,9 +451,9 @@ contains end if - else if (beta == done) then + else if (beta == sone) then - if (alpha == done) then + if (alpha == sone) then do i=1,m acc(1:nc) = y(i,1:nc) do j=irp(i), irp(i+1)-1 @@ -462,7 +462,7 @@ contains y(i,1:nc) = acc(1:nc) end do - else if (alpha == -done) then + else if (alpha == -sone) then do i=1,m acc(1:nc) = y(i,1:nc) @@ -475,7 +475,7 @@ contains else do i=1,m - acc(1:nc) = dzero + acc(1:nc) = szero do j=irp(i), irp(i+1)-1 acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc) enddo @@ -484,21 +484,21 @@ contains end if - else if (beta == -done) then + else if (beta == -sone) then - if (alpha == done) then + if (alpha == sone) then do i=1,m - acc(1:nc) = dzero + acc(1:nc) = szero do j=irp(i), irp(i+1)-1 acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc) enddo y(i,1:nc) = -y(i,1:nc) + acc(1:nc) end do - else if (alpha == -done) then + else if (alpha == -sone) then do i=1,m - acc(1:nc) = dzero + acc(1:nc) = szero do j=irp(i), irp(i+1)-1 acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc) enddo @@ -508,7 +508,7 @@ contains else do i=1,m - acc(1:nc) = dzero + acc(1:nc) = szero do j=irp(i), irp(i+1)-1 acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc) enddo @@ -519,19 +519,19 @@ contains else - if (alpha == done) then + if (alpha == sone) then do i=1,m - acc(1:nc) = dzero + acc(1:nc) = szero do j=irp(i), irp(i+1)-1 acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc) enddo y(i,1:nc) = beta*y(i,1:nc) + acc(1:nc) end do - else if (alpha == -done) then + else if (alpha == -sone) then do i=1,m - acc(1:nc) = dzero + acc(1:nc) = szero do j=irp(i), irp(i+1)-1 acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc) enddo @@ -541,7 +541,7 @@ contains else do i=1,m - acc(1:nc) = dzero + acc(1:nc) = szero do j=irp(i), irp(i+1)-1 acc(1:nc) = acc(1:nc) + val(j) * x(ja(j),1:nc) enddo @@ -554,13 +554,13 @@ contains else if (tra) then - if (beta == dzero) then + if (beta == szero) then do i=1, m - y(i,1:nc) = dzero + y(i,1:nc) = szero end do - else if (beta == done) then + else if (beta == sone) then ! Do nothing - else if (beta == -done) then + else if (beta == -sone) then do i=1, m y(i,1:nc) = -y(i,1:nc) end do @@ -570,7 +570,7 @@ contains end do end if - if (alpha == done) then + if (alpha == sone) then do i=1,n do j=irp(i), irp(i+1)-1 @@ -579,7 +579,7 @@ contains end do enddo - else if (alpha == -done) then + else if (alpha == -sone) then do i=1,n do j=irp(i), irp(i+1)-1 @@ -666,10 +666,10 @@ subroutine psb_s_csr_cssv(alpha,a,x,beta,y,info,trans) goto 9999 end if - if (alpha == dzero) then - if (beta == dzero) then + if (alpha == szero) then + if (beta == szero) then do i = 1, m - y(i) = dzero + y(i) = szero enddo else do i = 1, m @@ -679,13 +679,13 @@ subroutine psb_s_csr_cssv(alpha,a,x,beta,y,info,trans) return end if - if (beta == dzero) then + if (beta == szero) then call inner_csrsv(tra,a%is_lower(),a%is_unit(),a%get_nrows(),& & a%irp,a%ja,a%val,x,y) - if (alpha == done) then + if (alpha == sone) then ! do nothing - else if (alpha == -done) then + else if (alpha == -sone) then do i = 1, m y(i) = -y(i) end do @@ -737,7 +737,7 @@ contains if (lower) then if (unit) then do i=1, n - acc = dzero + acc = szero do j=irp(i), irp(i+1)-1 acc = acc + val(j)*y(ja(j)) end do @@ -745,7 +745,7 @@ contains end do else if (.not.unit) then do i=1, n - acc = dzero + acc = szero do j=irp(i), irp(i+1)-2 acc = acc + val(j)*y(ja(j)) end do @@ -756,7 +756,7 @@ contains if (unit) then do i=n, 1, -1 - acc = dzero + acc = szero do j=irp(i), irp(i+1)-1 acc = acc + val(j)*y(ja(j)) end do @@ -764,7 +764,7 @@ contains end do else if (.not.unit) then do i=n, 1, -1 - acc = dzero + acc = szero do j=irp(i)+1, irp(i+1)-1 acc = acc + val(j)*y(ja(j)) end do @@ -875,10 +875,10 @@ subroutine psb_s_csr_cssm(alpha,a,x,beta,y,info,trans) end if - if (alpha == dzero) then - if (beta == dzero) then + if (alpha == szero) then + if (beta == szero) then do i = 1, m - y(i,:) = dzero + y(i,:) = szero enddo else do i = 1, m @@ -888,7 +888,7 @@ subroutine psb_s_csr_cssm(alpha,a,x,beta,y,info,trans) return end if - if (beta == dzero) then + if (beta == szero) then call inner_csrsm(tra,a%is_lower(),a%is_unit(),a%get_nrows(),nc,& & a%irp,a%ja,a%val,x,size(x,1),y,size(y,1),info) do i = 1, m @@ -955,7 +955,7 @@ contains if (lower) then if (unit) then do i=1, nr - acc = dzero + acc = szero do j=irp(i), irp(i+1)-1 acc = acc + val(j)*y(ja(j),1:nc) end do @@ -963,7 +963,7 @@ contains end do else if (.not.unit) then do i=1, nr - acc = dzero + acc = szero do j=irp(i), irp(i+1)-2 acc = acc + val(j)*y(ja(j),1:nc) end do @@ -974,7 +974,7 @@ contains if (unit) then do i=nr, 1, -1 - acc = dzero + acc = szero do j=irp(i), irp(i+1)-1 acc = acc + val(j)*y(ja(j),1:nc) end do @@ -982,7 +982,7 @@ contains end do else if (.not.unit) then do i=nr, 1, -1 - acc = dzero + acc = szero do j=irp(i)+1, irp(i+1)-1 acc = acc + val(j)*y(ja(j),1:nc) end do @@ -1044,6 +1044,27 @@ contains end subroutine psb_s_csr_cssm +function psb_s_csr_maxval(a) result(res) + use psb_error_mod + use psb_s_csr_mat_mod, psb_protect_name => psb_s_csr_maxval + implicit none + class(psb_s_csr_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + + integer :: i,j,k,m,n, nnz, ir, jc, nc, info + character(len=20) :: name='d_csr_maxval' + logical, parameter :: debug=.false. + + + res = szero + nnz = a%get_nzeros() + if (allocated(a%val)) then + nnz = min(nnz,size(a%val)) + res = maxval(abs(a%val(1:nnz))) + end if +end function psb_s_csr_maxval + + function psb_s_csr_csnmi(a) result(res) use psb_error_mod use psb_s_csr_mat_mod, psb_protect_name => psb_s_csr_csnmi @@ -1059,10 +1080,10 @@ function psb_s_csr_csnmi(a) result(res) logical, parameter :: debug=.false. - res = dzero + res = szero do i = 1, a%get_nrows() - acc = dzero + acc = szero do j=a%irp(i),a%irp(i+1)-1 acc = acc + abs(a%val(j)) end do @@ -1071,6 +1092,246 @@ function psb_s_csr_csnmi(a) result(res) end function psb_s_csr_csnmi +function psb_s_csr_csnm1(a) result(res) + use psb_error_mod + use psb_const_mod + use psb_s_csr_mat_mod, psb_protect_name => psb_s_csr_csnm1 + + implicit none + class(psb_s_csr_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + + integer :: i,j,k,m,n, nnz, ir, jc, nc, info + real(psb_spk_) :: acc + real(psb_spk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act + character(len=20) :: name='d_csr_csnm1' + logical, parameter :: debug=.false. + + + res = -sone + nnz = a%get_nzeros() + m = a%get_nrows() + n = a%get_ncols() + allocate(vt(n),stat=info) + if (info /= 0) return + vt(:) = szero + do i=1, m + do j=a%irp(i),a%irp(i+1)-1 + k = a%ja(j) + vt(k) = vt(k) + abs(a%val(j)) + end do + end do + res = maxval(vt(1:n)) + deallocate(vt,stat=info) + + return + +end function psb_s_csr_csnm1 + +subroutine psb_s_csr_rowsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_s_csr_mat_mod, psb_protect_name => psb_s_csr_rowsum + class(psb_s_csr_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + real(psb_spk_) :: acc + real(psb_spk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='rowsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + m = a%get_nrows() + if (size(d) < m) then + info=psb_err_input_asize_small_i_ + int_err(1) = 1 + int_err(2) = size(d) + int_err(3) = m + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + do i = 1, a%get_nrows() + d(i) = szero + do j=a%irp(i),a%irp(i+1)-1 + d(i) = d(i) + (a%val(j)) + end do + end do + + return + 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 psb_s_csr_rowsum + +subroutine psb_s_csr_arwsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_s_csr_mat_mod, psb_protect_name => psb_s_csr_arwsum + class(psb_s_csr_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + real(psb_spk_) :: acc + real(psb_spk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='rowsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + m = a%get_nrows() + if (size(d) < m) then + info=psb_err_input_asize_small_i_ + int_err(1) = 1 + int_err(2) = size(d) + int_err(3) = m + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + + do i = 1, a%get_nrows() + d(i) = szero + do j=a%irp(i),a%irp(i+1)-1 + d(i) = d(i) + abs(a%val(j)) + end do + 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 psb_s_csr_arwsum + +subroutine psb_s_csr_colsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_s_csr_mat_mod, psb_protect_name => psb_s_csr_colsum + class(psb_s_csr_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + real(psb_spk_) :: acc + real(psb_spk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='colsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + m = a%get_nrows() + n = a%get_ncols() + if (size(d) < n) then + info=psb_err_input_asize_small_i_ + int_err(1) = 1 + int_err(2) = size(d) + int_err(3) = n + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + d = szero + + do i=1, m + do j=a%irp(i),a%irp(i+1)-1 + k = a%ja(j) + d(k) = d(k) + (a%val(j)) + end do + end do + + return + 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 psb_s_csr_colsum + +subroutine psb_s_csr_aclsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_s_csr_mat_mod, psb_protect_name => psb_s_csr_aclsum + class(psb_s_csr_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + real(psb_spk_) :: acc + real(psb_spk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='aclsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + m = a%get_nrows() + n = a%get_ncols() + if (size(d) < n) then + info=psb_err_input_asize_small_i_ + int_err(1) = 1 + int_err(2) = size(d) + int_err(3) = n + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + d = szero + + do i=1, m + do j=a%irp(i),a%irp(i+1)-1 + k = a%ja(j) + d(k) = d(k) + abs(a%val(j)) + end do + end do + + return + 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 psb_s_csr_aclsum + subroutine psb_s_csr_get_diag(a,d,info) use psb_error_mod use psb_const_mod @@ -1109,7 +1370,7 @@ subroutine psb_s_csr_get_diag(a,d,info) end do end if do i=mnm+1,size(d) - d(i) = dzero + d(i) = szero end do call psb_erractionrestore(err_act) return @@ -2076,7 +2337,7 @@ subroutine psb_s_csr_reinit(a,clear) ! do nothing return else if (a%is_asb()) then - if (clear_) a%val(:) = dzero + if (clear_) a%val(:) = szero call a%set_upd() else info = psb_err_invalid_mat_state_ diff --git a/base/serial/impl/psb_s_mat_impl.F90 b/base/serial/impl/psb_s_mat_impl.F90 index 327784726..ce52a829e 100644 --- a/base/serial/impl/psb_s_mat_impl.F90 +++ b/base/serial/impl/psb_s_mat_impl.F90 @@ -1834,6 +1834,56 @@ subroutine psb_s_csmv(alpha,a,x,beta,y,info,trans) end subroutine psb_s_csmv +subroutine psb_s_csmv_vect(alpha,a,x,beta,y,info,trans) + use psb_error_mod + use psb_s_vect_mod + use psb_s_mat_mod, psb_protect_name => psb_s_csmv_vect + implicit none + class(psb_sspmat_type), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta + type(psb_s_vect_type), intent(inout) :: x + type(psb_s_vect_type), intent(inout) :: y + integer, intent(out) :: info + character, optional, intent(in) :: trans + Integer :: err_act + character(len=20) :: name='psb_csmv' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + if (.not.allocated(a%a)) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(y%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + call a%a%csmm(alpha,x%v,beta,y%v,info,trans) + if (info /= psb_success_) 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 psb_s_csmv_vect + subroutine psb_s_cssm(alpha,a,x,beta,y,info,trans,scale,d) use psb_error_mod @@ -1916,6 +1966,99 @@ subroutine psb_s_cssv(alpha,a,x,beta,y,info,trans,scale,d) end subroutine psb_s_cssv +subroutine psb_s_cssv_vect(alpha,a,x,beta,y,info,trans,scale,d) + use psb_error_mod + use psb_s_vect_mod + use psb_s_mat_mod, psb_protect_name => psb_s_cssv_vect + implicit none + class(psb_sspmat_type), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta + type(psb_s_vect_type), intent(inout) :: x + type(psb_s_vect_type), intent(inout) :: y + integer, intent(out) :: info + character, optional, intent(in) :: trans, scale + type(psb_s_vect_type), optional, intent(inout) :: d + Integer :: err_act + character(len=20) :: name='psb_cssv' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + if (.not.allocated(a%a)) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(y%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (present(d)) then + if (.not.allocated(d%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + call a%a%cssm(alpha,x%v,beta,y%v,info,trans,scale,d%v) + else + call a%a%cssm(alpha,x%v,beta,y%v,info,trans,scale) + end if + + if (info /= psb_success_) 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 psb_s_cssv_vect + +function psb_s_maxval(a) result(res) + use psb_s_mat_mod, psb_protect_name => psb_s_maxval + use psb_error_mod + use psb_const_mod + implicit none + class(psb_sspmat_type), intent(in) :: a + real(psb_spk_) :: res + + + Integer :: err_act, info + character(len=20) :: name='maxval' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + info = psb_success_ + if (.not.allocated(a%a)) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + res = a%a%maxval() + return + +9999 continue + + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + +end function psb_s_maxval function psb_s_csnmi(a) result(res) use psb_s_mat_mod, psb_protect_name => psb_s_csnmi @@ -1929,8 +2072,8 @@ function psb_s_csnmi(a) result(res) character(len=20) :: name='csnmi' logical, parameter :: debug=.false. - info = psb_success_ call psb_get_erraction(err_act) + info = psb_success_ if (.not.allocated(a%a)) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) @@ -1951,6 +2094,192 @@ function psb_s_csnmi(a) result(res) end function psb_s_csnmi +function psb_s_csnm1(a) result(res) + use psb_s_mat_mod, psb_protect_name => psb_s_csnm1 + use psb_error_mod + use psb_const_mod + implicit none + class(psb_sspmat_type), intent(in) :: a + real(psb_spk_) :: res + + Integer :: err_act, info + character(len=20) :: name='csnm1' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + info = psb_success_ + if (.not.allocated(a%a)) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + res = a%a%csnm1() + return + +9999 continue + + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + +end function psb_s_csnm1 + + +subroutine psb_s_rowsum(d,a,info) + use psb_s_mat_mod, psb_protect_name => psb_s_rowsum + use psb_error_mod + use psb_const_mod + implicit none + class(psb_sspmat_type), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + integer, intent(out) :: info + + Integer :: err_act + character(len=20) :: name='rowsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + if (.not.allocated(a%a)) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + call a%a%rowsum(d) + if (info /= psb_success_) 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 psb_s_rowsum + +subroutine psb_s_arwsum(d,a,info) + use psb_s_mat_mod, psb_protect_name => psb_s_arwsum + use psb_error_mod + use psb_const_mod + implicit none + class(psb_sspmat_type), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + integer, intent(out) :: info + + Integer :: err_act + character(len=20) :: name='arwsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + if (.not.allocated(a%a)) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + call a%a%arwsum(d) + if (info /= psb_success_) 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 psb_s_arwsum + +subroutine psb_s_colsum(d,a,info) + use psb_s_mat_mod, psb_protect_name => psb_s_colsum + use psb_error_mod + use psb_const_mod + implicit none + class(psb_sspmat_type), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + integer, intent(out) :: info + + Integer :: err_act + character(len=20) :: name='colsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + if (.not.allocated(a%a)) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + call a%a%colsum(d) + if (info /= psb_success_) 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 psb_s_colsum + +subroutine psb_s_aclsum(d,a,info) + use psb_s_mat_mod, psb_protect_name => psb_s_aclsum + use psb_error_mod + use psb_const_mod + implicit none + class(psb_sspmat_type), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + integer, intent(out) :: info + + Integer :: err_act + character(len=20) :: name='aclsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + if (.not.allocated(a%a)) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + call a%a%aclsum(d) + if (info /= psb_success_) 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 psb_s_aclsum + subroutine psb_s_get_diag(a,d,info) use psb_s_mat_mod, psb_protect_name => psb_s_get_diag use psb_error_mod @@ -1964,8 +2293,8 @@ subroutine psb_s_get_diag(a,d,info) character(len=20) :: name='get_diag' logical, parameter :: debug=.false. - info = psb_success_ call psb_erractionsave(err_act) + info = psb_success_ if (.not.allocated(a%a)) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) @@ -2003,8 +2332,8 @@ subroutine psb_s_scal(d,a,info) character(len=20) :: name='scal' logical, parameter :: debug=.false. - info = psb_success_ call psb_erractionsave(err_act) + info = psb_success_ if (.not.allocated(a%a)) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) @@ -2042,8 +2371,8 @@ subroutine psb_s_scals(d,a,info) character(len=20) :: name='scal' logical, parameter :: debug=.false. - info = psb_success_ call psb_erractionsave(err_act) + info = psb_success_ if (.not.allocated(a%a)) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) diff --git a/base/serial/impl/psb_z_base_mat_impl.f90 b/base/serial/impl/psb_z_base_mat_impl.f90 index d48e849a4..a783fd7e3 100644 --- a/base/serial/impl/psb_z_base_mat_impl.f90 +++ b/base/serial/impl/psb_z_base_mat_impl.f90 @@ -1037,6 +1037,34 @@ subroutine psb_z_base_scal(d,a,info) end subroutine psb_z_base_scal +function psb_z_base_maxval(a) result(res) + use psb_error_mod + use psb_const_mod + use psb_z_base_mat_mod, psb_protect_name => psb_z_base_maxval + + implicit none + class(psb_z_base_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + + Integer :: err_act, info + character(len=20) :: name='maxval' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + ! This is the base version. If we get here + ! it means the derived class is incomplete, + ! so we throw an error. + info = psb_err_missing_override_method_ + call psb_errpush(info,name,a_err=a%get_fmt()) + + if (err_act /= psb_act_ret_) then + call psb_error() + end if + res = -done + + return + +end function psb_z_base_maxval function psb_z_base_csnmi(a) result(res) use psb_error_mod @@ -1067,6 +1095,139 @@ function psb_z_base_csnmi(a) result(res) end function psb_z_base_csnmi +function psb_z_base_csnm1(a) result(res) + use psb_error_mod + use psb_const_mod + use psb_z_base_mat_mod, psb_protect_name => psb_z_base_csnm1 + + implicit none + class(psb_z_base_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + + Integer :: err_act, info + character(len=20) :: name='csnm1' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + ! This is the base version. If we get here + ! it means the derived class is incomplete, + ! so we throw an error. + info = psb_err_missing_override_method_ + call psb_errpush(info,name,a_err=a%get_fmt()) + + if (err_act /= psb_act_ret_) then + call psb_error() + end if + res = -sone + + return + +end function psb_z_base_csnm1 + +subroutine psb_z_base_rowsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_z_base_mat_mod, psb_protect_name => psb_z_base_rowsum + class(psb_z_base_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(out) :: d(:) + + Integer :: err_act, info + character(len=20) :: name='rowsum' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + ! This is the base version. If we get here + ! it means the derived class is incomplete, + ! so we throw an error. + info = psb_err_missing_override_method_ + call psb_errpush(info,name,a_err=a%get_fmt()) + + if (err_act /= psb_act_ret_) then + call psb_error() + end if + + return + +end subroutine psb_z_base_rowsum + +subroutine psb_z_base_arwsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_z_base_mat_mod, psb_protect_name => psb_z_base_arwsum + class(psb_z_base_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + + Integer :: err_act, info + character(len=20) :: name='arwsum' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + ! This is the base version. If we get here + ! it means the derived class is incomplete, + ! so we throw an error. + info = psb_err_missing_override_method_ + call psb_errpush(info,name,a_err=a%get_fmt()) + + if (err_act /= psb_act_ret_) then + call psb_error() + end if + + return + +end subroutine psb_z_base_arwsum + +subroutine psb_z_base_colsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_z_base_mat_mod, psb_protect_name => psb_z_base_colsum + class(psb_z_base_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(out) :: d(:) + + Integer :: err_act, info + character(len=20) :: name='colsum' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + ! This is the base version. If we get here + ! it means the derived class is incomplete, + ! so we throw an error. + info = psb_err_missing_override_method_ + call psb_errpush(info,name,a_err=a%get_fmt()) + + if (err_act /= psb_act_ret_) then + call psb_error() + end if + + return + +end subroutine psb_z_base_colsum + +subroutine psb_z_base_aclsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_z_base_mat_mod, psb_protect_name => psb_z_base_aclsum + class(psb_z_base_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + + Integer :: err_act, info + character(len=20) :: name='aclsum' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + ! This is the base version. If we get here + ! it means the derived class is incomplete, + ! so we throw an error. + info = psb_err_missing_override_method_ + call psb_errpush(info,name,a_err=a%get_fmt()) + + if (err_act /= psb_act_ret_) then + call psb_error() + end if + + return + +end subroutine psb_z_base_aclsum + subroutine psb_z_base_get_diag(a,d,info) use psb_error_mod use psb_const_mod @@ -1099,3 +1260,225 @@ end subroutine psb_z_base_get_diag + +! == ================================== +! +! +! +! Computational routines for Z_VECT +! variables. If the actual data type is +! a "normal" one, these are sufficient. +! +! +! +! +! == ================================== + + + +subroutine psb_z_base_vect_mv(alpha,a,x,beta,y,info,trans) + use psb_error_mod + use psb_const_mod + use psb_z_base_mat_mod, psb_protect_name => psb_z_base_vect_mv + implicit none + class(psb_z_base_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta + class(psb_z_base_vect_type), intent(inout) :: x + class(psb_z_base_vect_type), intent(inout) :: y + integer, intent(out) :: info + character, optional, intent(in) :: trans + + ! For the time being we just throw everything back + ! onto the normal routines. + call x%sync() + call y%sync() + call a%csmm(alpha,x%v,beta,y%v,info,trans) + +end subroutine psb_z_base_vect_mv + +subroutine psb_z_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d) + use psb_z_base_mat_mod, psb_protect_name => psb_z_base_vect_cssv + use psb_z_base_vect_mod + use psb_error_mod + use psb_string_mod + implicit none + class(psb_z_base_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta + class(psb_z_base_vect_type), intent(inout) :: x,y + integer, intent(out) :: info + character, optional, intent(in) :: trans, scale + class(psb_z_base_vect_type), intent(inout),optional :: d + + complex(psb_dpk_), allocatable :: tmp(:) + class(psb_z_base_vect_type), allocatable :: tmpv + Integer :: err_act, nar,nac,nc, i + character(len=1) :: scale_ + character(len=20) :: name='s_cssm' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + if (.not.a%is_asb()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + nar = a%get_nrows() + nac = a%get_ncols() + nc = 1 + if (x%get_nrows() < nac) then + info = 36 + call psb_errpush(info,name,i_err=(/3,nac,0,0,0/)) + goto 9999 + end if + if (y%get_nrows() < nar) then + info = 36 + call psb_errpush(info,name,i_err=(/3,nar,0,0,0/)) + goto 9999 + end if + + if (.not. (a%is_triangle())) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + end if + + call x%sync() + call y%sync() + if (present(d)) then + call d%sync() + if (present(scale)) then + scale_ = scale + else + scale_ = 'L' + end if + + if (psb_toupper(scale_) == 'R') then + if (d%get_nrows() < nac) then + info = 36 + call psb_errpush(info,name,i_err=(/9,nac,0,0,0/)) + goto 9999 + end if + + allocate(tmpv, mold=y,stat=info) + ! allocate(tmp(nac),stat=info) + if (info /= psb_success_) info = psb_err_alloc_dealloc_ + if (info == psb_success_) call tmpv%mlt(zone,d%v(1:nac),x,zzero,info) + if (info == psb_success_)& + & call a%inner_cssm(alpha,tmpv,beta,y,info,trans) + + if (info == psb_success_) then + call tmpv%free(info) + if (info == psb_success_) deallocate(tmpv,stat=info) + if (info /= psb_success_) info = psb_err_alloc_dealloc_ + end if + + else if (psb_toupper(scale_) == 'L') then + if (d%get_nrows() < nar) then + info = 36 + call psb_errpush(info,name,i_err=(/9,nar,0,0,0/)) + goto 9999 + end if + + if (beta == zzero) then + call a%inner_cssm(alpha,x,zzero,y,info,trans) + if (info == psb_success_) call y%mlt(d%v(1:nar),info) +!!$ if (info == psb_success_) call inner_vscal1(nar,d,y) + else + ! allocate(tmp(nar),stat=info) + allocate(tmpv, mold=y,stat=info) + if (info /= psb_success_) info = psb_err_alloc_dealloc_ + if (info == psb_success_)& + & call a%inner_cssm(alpha,x,zzero,tmpv,info,trans) + + if (info == psb_success_) call tmpv%mlt(d%v(1:nar),info) + if (info == psb_success_)& + & call y%axpby(nar,zone,tmpv,beta,info) + if (info == psb_success_) then + call tmpv%free(info) + if (info == psb_success_) deallocate(tmpv,stat=info) + if (info /= psb_success_) info = psb_err_alloc_dealloc_ + end if + end if + + else + info = 31 + call psb_errpush(info,name,i_err=(/8,0,0,0,0/),a_err=scale_) + goto 9999 + end if + else + ! Scale is ignored in this case + call a%inner_cssm(alpha,x,beta,y,info,trans) + end if + + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='inner_cssm') + 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 psb_z_base_vect_cssv + + +subroutine psb_z_base_inner_vect_sv(alpha,a,x,beta,y,info,trans) + use psb_z_base_mat_mod, psb_protect_name => psb_z_base_inner_vect_sv + use psb_error_mod + use psb_string_mod + use psb_z_base_vect_mod + implicit none + class(psb_z_base_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta + class(psb_z_base_vect_type), intent(inout) :: x, y + integer, intent(out) :: info + character, optional, intent(in) :: trans + + Integer :: err_act + character(len=20) :: name='s_base_inner_vect_sv' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + ! This is the base version. If we get here + ! it means the derived class is incomplete, + ! so we throw an error. + info = psb_success_ + + call a%inner_cssm(alpha,x%v,beta,y%v,info,trans) + + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name, a_err='inner_cssm') + 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 psb_z_base_inner_vect_sv + + diff --git a/base/serial/impl/psb_z_coo_impl.f90 b/base/serial/impl/psb_z_coo_impl.f90 index b156427cf..29229656a 100644 --- a/base/serial/impl/psb_z_coo_impl.f90 +++ b/base/serial/impl/psb_z_coo_impl.f90 @@ -1565,6 +1565,26 @@ subroutine psb_z_coo_csmm(alpha,a,x,beta,y,info,trans) end subroutine psb_z_coo_csmm +function psb_z_coo_maxval(a) result(res) + use psb_error_mod + use psb_z_base_mat_mod, psb_protect_name => psb_z_coo_maxval + implicit none + class(psb_z_coo_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + + integer :: i,j,k,m,n, nnz, ir, jc, nc, info + character(len=20) :: name='c_coo_maxval' + logical, parameter :: debug=.false. + + + res = dzero + nnz = a%get_nzeros() + if (allocated(a%val)) then + nnz = min(nnz,size(a%val)) + res = maxval(abs(a%val(1:nnz))) + end if +end function psb_z_coo_maxval + function psb_z_coo_csnmi(a) result(res) use psb_error_mod use psb_z_base_mat_mod, psb_protect_name => psb_z_coo_csnmi @@ -1599,6 +1619,237 @@ function psb_z_coo_csnmi(a) result(res) end function psb_z_coo_csnmi +function psb_z_coo_csnm1(a) result(res) + use psb_error_mod + use psb_const_mod + use psb_z_base_mat_mod, psb_protect_name => psb_z_coo_csnm1 + + implicit none + class(psb_z_coo_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + + integer :: i,j,k,m,n, nnz, ir, jc, nc, info + real(psb_dpk_) :: acc + real(psb_dpk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act + character(len=20) :: name='d_coo_csnm1' + logical, parameter :: debug=.false. + + + res = -done + nnz = a%get_nzeros() + n = a%get_ncols() + allocate(vt(n),stat=info) + if (info /= 0) return + vt(:) = dzero + do j=1, nnz + i = a%ja(j) + vt(i) = vt(i) + abs(a%val(j)) + end do + res = maxval(vt(1:n)) + deallocate(vt,stat=info) + + return + +end function psb_z_coo_csnm1 + +subroutine psb_z_coo_rowsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_z_base_mat_mod, psb_protect_name => psb_z_coo_rowsum + class(psb_z_coo_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + complex(psb_dpk_) :: acc + complex(psb_dpk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='rowsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + m = a%get_nrows() + if (size(d) < m) then + info=psb_err_input_asize_small_i_ + int_err(1) = 1 + int_err(2) = size(d) + int_err(3) = m + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + d = zzero + nnz = a%get_nzeros() + do j=1, nnz + i = a%ia(j) + d(i) = d(i) + a%val(j) + end do + + return + 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 psb_z_coo_rowsum + +subroutine psb_z_coo_arwsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_z_base_mat_mod, psb_protect_name => psb_z_coo_arwsum + class(psb_z_coo_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + real(psb_dpk_) :: acc + real(psb_dpk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='rowsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + m = a%get_nrows() + if (size(d) < m) then + info=psb_err_input_asize_small_i_ + int_err(1) = 1 + int_err(2) = size(d) + int_err(3) = m + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + d = dzero + nnz = a%get_nzeros() + do j=1, nnz + i = a%ia(j) + d(i) = d(i) + abs(a%val(j)) + end do + + return + 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 psb_z_coo_arwsum + +subroutine psb_z_coo_colsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_z_base_mat_mod, psb_protect_name => psb_z_coo_colsum + class(psb_z_coo_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + complex(psb_dpk_) :: acc + complex(psb_dpk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='colsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + n = a%get_ncols() + if (size(d) < n) then + info=psb_err_input_asize_small_i_ + int_err(1) = 1 + int_err(2) = size(d) + int_err(3) = n + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + d = zzero + nnz = a%get_nzeros() + do j=1, nnz + k = a%ja(j) + d(k) = d(k) + a%val(j) + end do + + return + 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 psb_z_coo_colsum + +subroutine psb_z_coo_aclsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_z_base_mat_mod, psb_protect_name => psb_z_coo_aclsum + class(psb_z_coo_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + real(psb_dpk_) :: acc + real(psb_dpk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='aclsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + n = a%get_ncols() + if (size(d) < n) then + info=psb_err_input_asize_small_i_ + int_err(1) = 1 + int_err(2) = size(d) + int_err(3) = n + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + d = dzero + nnz = a%get_nzeros() + do j=1, nnz + k = a%ja(j) + d(k) = d(k) + abs(a%val(j)) + end do + + return + 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 psb_z_coo_aclsum + ! == ================================== ! diff --git a/base/serial/impl/psb_z_csc_impl.f90 b/base/serial/impl/psb_z_csc_impl.f90 index 55d0b169c..1618df2e9 100644 --- a/base/serial/impl/psb_z_csc_impl.f90 +++ b/base/serial/impl/psb_z_csc_impl.f90 @@ -1389,6 +1389,26 @@ contains end subroutine psb_z_csc_cssm +function psb_z_csc_maxval(a) result(res) + use psb_error_mod + use psb_z_csc_mat_mod, psb_protect_name => psb_z_csc_maxval + implicit none + class(psb_z_csc_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + + integer :: i,j,k,m,n, nnz, ir, jc, nc, info + character(len=20) :: name='z_csc_maxval' + logical, parameter :: debug=.false. + + + res = dzero + nnz = a%get_nzeros() + if (allocated(a%val)) then + nnz = min(nnz,size(a%val)) + res = maxval(abs(a%val(1:nnz))) + end if +end function psb_z_csc_maxval + function psb_z_csc_csnmi(a) result(res) use psb_error_mod use psb_z_csc_mat_mod, psb_protect_name => psb_z_csc_csnmi @@ -1425,6 +1445,242 @@ function psb_z_csc_csnmi(a) result(res) end function psb_z_csc_csnmi +function psb_z_csc_csnm1(a) result(res) + use psb_error_mod + use psb_const_mod + use psb_z_csc_mat_mod, psb_protect_name => psb_z_csc_csnm1 + + implicit none + class(psb_z_csc_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + + integer :: i,j,k,m,n, nnz, ir, jc, nc, info + real(psb_dpk_) :: acc + real(psb_dpk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act + character(len=20) :: name='d_csc_csnm1' + logical, parameter :: debug=.false. + + + res = dzero + m = a%get_nrows() + n = a%get_ncols() + do j=1, n + acc = dzero + do k=a%icp(j),a%icp(j+1)-1 + acc = acc + abs(a%val(k)) + end do + res = max(res,acc) + end do + + return + +end function psb_z_csc_csnm1 + +subroutine psb_z_csc_colsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_z_csc_mat_mod, psb_protect_name => psb_z_csc_colsum + class(psb_z_csc_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + complex(psb_dpk_) :: acc + complex(psb_dpk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='colsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + m = a%get_ncols() + if (size(d) < m) then + info=psb_err_input_asize_small_i_ + int_err(1) = 1 + int_err(2) = size(d) + int_err(3) = m + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + do i = 1, a%get_ncols() + d(i) = zzero + do j=a%icp(i),a%icp(i+1)-1 + d(i) = d(i) + (a%val(j)) + end do + end do + + return + 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 psb_z_csc_colsum + +subroutine psb_z_csc_aclsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_z_csc_mat_mod, psb_protect_name => psb_z_csc_aclsum + class(psb_z_csc_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + real(psb_dpk_) :: acc + real(psb_dpk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='colsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + m = a%get_ncols() + if (size(d) < m) then + info=psb_err_input_asize_small_i_ + int_err(1) = 1 + int_err(2) = size(d) + int_err(3) = m + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + + do i = 1, a%get_ncols() + d(i) = dzero + do j=a%icp(i),a%icp(i+1)-1 + d(i) = d(i) + abs(a%val(j)) + end do + 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 psb_z_csc_aclsum + +subroutine psb_z_csc_rowsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_z_csc_mat_mod, psb_protect_name => psb_z_csc_rowsum + class(psb_z_csc_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + complex(psb_dpk_) :: acc + complex(psb_dpk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='rowsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + m = a%get_ncols() + n = a%get_nrows() + if (size(d) < n) then + info=psb_err_input_asize_small_i_ + int_err(1) = 1 + int_err(2) = size(d) + int_err(3) = n + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + d = zzero + + do i=1, m + do j=a%icp(i),a%icp(i+1)-1 + k = a%ia(j) + d(k) = d(k) + (a%val(k)) + end do + end do + + return + 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 psb_z_csc_rowsum + +subroutine psb_z_csc_arwsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_z_csc_mat_mod, psb_protect_name => psb_z_csc_arwsum + class(psb_z_csc_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + real(psb_dpk_) :: acc + real(psb_dpk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='arwsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + m = a%get_ncols() + n = a%get_nrows() + if (size(d) < n) then + info=psb_err_input_asize_small_i_ + int_err(1) = 1 + int_err(2) = size(d) + int_err(3) = n + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + d = dzero + + do i=1, m + do j=a%icp(i),a%icp(i+1)-1 + k = a%ia(j) + d(k) = d(k) + abs(a%val(k)) + end do + end do + + return + 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 psb_z_csc_arwsum + + subroutine psb_z_csc_get_diag(a,d,info) use psb_error_mod use psb_const_mod diff --git a/base/serial/impl/psb_z_csr_impl.f90 b/base/serial/impl/psb_z_csr_impl.f90 index 892e6f3c7..75d7ff103 100644 --- a/base/serial/impl/psb_z_csr_impl.f90 +++ b/base/serial/impl/psb_z_csr_impl.f90 @@ -1237,6 +1237,26 @@ contains end subroutine psb_z_csr_cssm +function psb_z_csr_maxval(a) result(res) + use psb_error_mod + use psb_z_csr_mat_mod, psb_protect_name => psb_z_csr_maxval + implicit none + class(psb_z_csr_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + + integer :: i,j,k,m,n, nnz, ir, jc, nc, info + character(len=20) :: name='z_csr_maxval' + logical, parameter :: debug=.false. + + + res = dzero + nnz = a%get_nzeros() + if (allocated(a%val)) then + nnz = min(nnz,size(a%val)) + res = maxval(abs(a%val(1:nnz))) + end if +end function psb_z_csr_maxval + function psb_z_csr_csnmi(a) result(res) use psb_error_mod use psb_z_csr_mat_mod, psb_protect_name => psb_z_csr_csnmi @@ -1264,6 +1284,246 @@ function psb_z_csr_csnmi(a) result(res) end function psb_z_csr_csnmi +function psb_z_csr_csnm1(a) result(res) + use psb_error_mod + use psb_const_mod + use psb_z_csr_mat_mod, psb_protect_name => psb_z_csr_csnm1 + + implicit none + class(psb_z_csr_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + + integer :: i,j,k,m,n, nnz, ir, jc, nc, info + real(psb_dpk_) :: acc + real(psb_dpk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act + character(len=20) :: name='d_csr_csnm1' + logical, parameter :: debug=.false. + + + res = -sone + nnz = a%get_nzeros() + m = a%get_nrows() + n = a%get_ncols() + allocate(vt(n),stat=info) + if (info /= 0) return + vt(:) = dzero + do i=1, m + do j=a%irp(i),a%irp(i+1)-1 + k = a%ja(j) + vt(k) = vt(k) + abs(a%val(j)) + end do + end do + res = maxval(vt(1:n)) + deallocate(vt,stat=info) + + return + +end function psb_z_csr_csnm1 + +subroutine psb_z_csr_rowsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_z_csr_mat_mod, psb_protect_name => psb_z_csr_rowsum + class(psb_z_csr_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + complex(psb_dpk_) :: acc + complex(psb_dpk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='rowsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + m = a%get_nrows() + if (size(d) < m) then + info=psb_err_input_asize_small_i_ + int_err(1) = 1 + int_err(2) = size(d) + int_err(3) = m + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + do i = 1, a%get_nrows() + d(i) = zzero + do j=a%irp(i),a%irp(i+1)-1 + d(i) = d(i) + (a%val(j)) + end do + end do + + return + 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 psb_z_csr_rowsum + +subroutine psb_z_csr_arwsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_z_csr_mat_mod, psb_protect_name => psb_z_csr_arwsum + class(psb_z_csr_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + real(psb_dpk_) :: acc + real(psb_dpk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='rowsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + m = a%get_nrows() + if (size(d) < m) then + info=psb_err_input_asize_small_i_ + int_err(1) = 1 + int_err(2) = size(d) + int_err(3) = m + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + + do i = 1, a%get_nrows() + d(i) = dzero + do j=a%irp(i),a%irp(i+1)-1 + d(i) = d(i) + abs(a%val(j)) + end do + 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 psb_z_csr_arwsum + +subroutine psb_z_csr_colsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_z_csr_mat_mod, psb_protect_name => psb_z_csr_colsum + class(psb_z_csr_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + complex(psb_dpk_) :: acc + complex(psb_dpk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='colsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + m = a%get_nrows() + n = a%get_ncols() + if (size(d) < n) then + info=psb_err_input_asize_small_i_ + int_err(1) = 1 + int_err(2) = size(d) + int_err(3) = n + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + d = zzero + + do i=1, m + do j=a%irp(i),a%irp(i+1)-1 + k = a%ja(j) + d(k) = d(k) + (a%val(j)) + end do + end do + + return + 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 psb_z_csr_colsum + +subroutine psb_z_csr_aclsum(d,a) + use psb_error_mod + use psb_const_mod + use psb_z_csr_mat_mod, psb_protect_name => psb_z_csr_aclsum + class(psb_z_csr_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + + integer :: i,j,k,m,n, nnz, ir, jc, nc + real(psb_dpk_) :: acc + real(psb_dpk_), allocatable :: vt(:) + logical :: tra + Integer :: err_act, info, int_err(5) + character(len=20) :: name='aclsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + m = a%get_nrows() + n = a%get_ncols() + if (size(d) < n) then + info=psb_err_input_asize_small_i_ + int_err(1) = 1 + int_err(2) = size(d) + int_err(3) = n + call psb_errpush(info,name,i_err=int_err) + goto 9999 + end if + + d = dzero + + do i=1, m + do j=a%irp(i),a%irp(i+1)-1 + k = a%ja(j) + d(k) = d(k) + abs(a%val(j)) + end do + end do + + return + 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 psb_z_csr_aclsum + subroutine psb_z_csr_get_diag(a,d,info) use psb_error_mod use psb_const_mod diff --git a/base/serial/impl/psb_z_mat_impl.F90 b/base/serial/impl/psb_z_mat_impl.F90 index 716c5e350..78268c06b 100644 --- a/base/serial/impl/psb_z_mat_impl.F90 +++ b/base/serial/impl/psb_z_mat_impl.F90 @@ -1834,6 +1834,57 @@ subroutine psb_z_csmv(alpha,a,x,beta,y,info,trans) end subroutine psb_z_csmv +subroutine psb_z_csmv_vect(alpha,a,x,beta,y,info,trans) + use psb_error_mod + use psb_z_vect_mod + use psb_z_mat_mod, psb_protect_name => psb_z_csmv_vect + implicit none + class(psb_zspmat_type), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta + type(psb_z_vect_type), intent(inout) :: x + type(psb_z_vect_type), intent(inout) :: y + integer, intent(out) :: info + character, optional, intent(in) :: trans + Integer :: err_act + character(len=20) :: name='psb_csmv' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + if (.not.allocated(a%a)) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(y%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + call a%a%csmm(alpha,x%v,beta,y%v,info,trans) + if (info /= psb_success_) 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 psb_z_csmv_vect + + subroutine psb_z_cssm(alpha,a,x,beta,y,info,trans,scale,d) use psb_error_mod @@ -1916,6 +1967,99 @@ subroutine psb_z_cssv(alpha,a,x,beta,y,info,trans,scale,d) end subroutine psb_z_cssv +subroutine psb_z_cssv_vect(alpha,a,x,beta,y,info,trans,scale,d) + use psb_error_mod + use psb_z_vect_mod + use psb_z_mat_mod, psb_protect_name => psb_z_cssv_vect + implicit none + class(psb_zspmat_type), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta + type(psb_z_vect_type), intent(inout) :: x + type(psb_z_vect_type), intent(inout) :: y + integer, intent(out) :: info + character, optional, intent(in) :: trans, scale + type(psb_z_vect_type), optional, intent(inout) :: d + Integer :: err_act + character(len=20) :: name='psb_cssv' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_erractionsave(err_act) + if (.not.allocated(a%a)) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(y%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (present(d)) then + if (.not.allocated(d%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + call a%a%cssm(alpha,x%v,beta,y%v,info,trans,scale,d%v) + else + call a%a%cssm(alpha,x%v,beta,y%v,info,trans,scale) + end if + + if (info /= psb_success_) 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 psb_z_cssv_vect + +function psb_z_maxval(a) result(res) + use psb_z_mat_mod, psb_protect_name => psb_z_maxval + use psb_error_mod + use psb_const_mod + implicit none + class(psb_zspmat_type), intent(in) :: a + real(psb_dpk_) :: res + + + Integer :: err_act, info + character(len=20) :: name='maxval' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + info = psb_success_ + if (.not.allocated(a%a)) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + res = a%a%maxval() + return + +9999 continue + + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + +end function psb_z_maxval function psb_z_csnmi(a) result(res) use psb_z_mat_mod, psb_protect_name => psb_z_csnmi @@ -1951,6 +2095,193 @@ function psb_z_csnmi(a) result(res) end function psb_z_csnmi +function psb_z_csnm1(a) result(res) + use psb_z_mat_mod, psb_protect_name => psb_z_csnm1 + use psb_error_mod + use psb_const_mod + implicit none + class(psb_zspmat_type), intent(in) :: a + real(psb_dpk_) :: res + + Integer :: err_act, info + character(len=20) :: name='csnm1' + logical, parameter :: debug=.false. + + call psb_get_erraction(err_act) + info = psb_success_ + if (.not.allocated(a%a)) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + res = a%a%csnm1() + return + +9999 continue + + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + +end function psb_z_csnm1 + + +subroutine psb_z_rowsum(d,a,info) + use psb_z_mat_mod, psb_protect_name => psb_z_rowsum + use psb_error_mod + use psb_const_mod + implicit none + class(psb_zspmat_type), intent(in) :: a + complex(psb_dpk_), intent(out) :: d(:) + integer, intent(out) :: info + + Integer :: err_act + character(len=20) :: name='rowsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + if (.not.allocated(a%a)) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + call a%a%rowsum(d) + if (info /= psb_success_) 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 psb_z_rowsum + +subroutine psb_z_arwsum(d,a,info) + use psb_z_mat_mod, psb_protect_name => psb_z_arwsum + use psb_error_mod + use psb_const_mod + implicit none + class(psb_zspmat_type), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + integer, intent(out) :: info + + Integer :: err_act + character(len=20) :: name='arwsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + if (.not.allocated(a%a)) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + call a%a%arwsum(d) + if (info /= psb_success_) 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 psb_z_arwsum + +subroutine psb_z_colsum(d,a,info) + use psb_z_mat_mod, psb_protect_name => psb_z_colsum + use psb_error_mod + use psb_const_mod + implicit none + class(psb_zspmat_type), intent(in) :: a + complex(psb_dpk_), intent(out) :: d(:) + integer, intent(out) :: info + + Integer :: err_act + character(len=20) :: name='colsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + if (.not.allocated(a%a)) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + call a%a%colsum(d) + if (info /= psb_success_) 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 psb_z_colsum + +subroutine psb_z_aclsum(d,a,info) + use psb_z_mat_mod, psb_protect_name => psb_z_aclsum + use psb_error_mod + use psb_const_mod + implicit none + class(psb_zspmat_type), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + integer, intent(out) :: info + + Integer :: err_act + character(len=20) :: name='aclsum' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + if (.not.allocated(a%a)) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + call a%a%aclsum(d) + if (info /= psb_success_) 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 psb_z_aclsum + + subroutine psb_z_get_diag(a,d,info) use psb_z_mat_mod, psb_protect_name => psb_z_get_diag use psb_error_mod diff --git a/base/serial/psb_cgelp.f90 b/base/serial/psb_cgelp.f90 new file mode 100644 index 000000000..2dbb92125 --- /dev/null +++ b/base/serial/psb_cgelp.f90 @@ -0,0 +1,258 @@ +!!$ +!!$ Parallel Sparse BLAS version 2.2 +!!$ (C) Copyright 2006/2007/2008 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +! File: psb_cgelp.f90 +! +! +! Subroutine: psb_cgelp +! Apply a left permutation to a dense matrix +! +! Arguments: +! trans - character. +! iperm - integer. +! x - real, dimension(:,:). +! info - integer. Return code. +subroutine psb_cgelp(trans,iperm,x,info) + use psb_serial_mod, psb_protect_name => psb_cgelp + use psb_const_mod + use psb_error_mod + implicit none + + complex(psb_spk_), intent(inout) :: x(:,:) + integer, intent(in) :: iperm(:) + integer, intent(out) :: info + character, intent(in) :: trans + + ! local variables + complex(psb_spk_),allocatable :: temp(:) + integer :: int_err(5), i1sz, i2sz, err_act,i,j + integer, allocatable :: itemp(:) + complex(psb_spk_),parameter :: one=1 + integer :: debug_level, debug_unit + + character(len=20) :: name, ch_err + name = 'psb_cgelp' + + if(psb_get_errstatus() /= 0) return + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + i1sz = size(x,dim=1) + i2sz = size(x,dim=2) + + if (debug_level >= psb_debug_serial_)& + & write(debug_unit,*) trim(name),': size',i1sz,i2sz + + allocate(temp(i1sz),itemp(size(iperm)),stat=info) + if (info /= psb_success_) then + info=2040 + call psb_errpush(info,name) + goto 9999 + end if + itemp(:) = iperm(:) + + if (.not.psb_isaperm(i1sz,itemp)) then + info=psb_err_iarg_invalid_value_ + int_err(1) = 1 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + endif + select case( psb_toupper(trans)) + case('N') + do j=1,i2sz + do i=1,i1sz + temp(i) = x(itemp(i),j) + end do + do i=1,i1sz + x(i,j) = temp(i) + end do + end do + case('T') + do j=1,i2sz + do i=1,i1sz + temp(itemp(i)) = x(i,j) + end do + do i=1,i1sz + x(i,j) = temp(i) + end do + end do + case default + info=psb_err_from_subroutine_ + ch_err='dgelp' + call psb_errpush(info,name,a_err=ch_err) + end select + + deallocate(temp,itemp) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_ret_) then + return + else + call psb_error() + end if + return + +end subroutine psb_cgelp + + + +!!$ +!!$ Parallel Sparse BLAS version 2.2 +!!$ (C) Copyright 2006/2007/2008 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +! +! +! Subroutine: psb_cgelpv +! Apply a left permutation to a dense matrix +! +! Arguments: +! trans - character. +! iperm - integer. +! x - real, dimension(:). +! info - integer. Return code. +subroutine psb_cgelpv(trans,iperm,x,info) + use psb_serial_mod, psb_protect_name => psb_cgelpv + use psb_const_mod + use psb_error_mod + implicit none + + complex(psb_spk_), intent(inout) :: x(:) + integer, intent(in) :: iperm(:) + integer, intent(out) :: info + character, intent(in) :: trans + + ! local variables + integer :: int_err(5), i1sz, err_act, i + complex(psb_spk_),allocatable :: temp(:) + integer, allocatable :: itemp(:) + complex(psb_spk_),parameter :: one=1 + integer :: debug_level, debug_unit + + character(len=20) :: name, ch_err + name = 'psb_cgelpv' + + if(psb_get_errstatus() /= 0) return + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + i1sz = min(size(x),size(iperm)) + + if (debug_level >= psb_debug_serial_)& + & write(debug_unit,*) trim(name),': size',i1sz + allocate(temp(i1sz),itemp(size(iperm)),stat=info) + if (info /= psb_success_) then + info=2040 + call psb_errpush(info,name) + goto 9999 + end if + itemp(:) = iperm(:) + + if (.not.psb_isaperm(i1sz,itemp)) then + info=psb_err_iarg_invalid_value_ + int_err(1) = 1 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + endif + + select case( psb_toupper(trans)) + case('N') + do i=1,i1sz + temp(i) = x(itemp(i)) + end do + do i=1,i1sz + x(i) = temp(i) + end do + case('T') + do i=1,i1sz + temp(itemp(i)) = x(i) + end do + do i=1,i1sz + x(i) = temp(i) + end do + case default + info=psb_err_from_subroutine_ + ch_err='dgelp' + call psb_errpush(info,name,a_err=ch_err) + end select + + deallocate(temp,itemp) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_ret_) then + return + else + call psb_error() + end if + return + +end subroutine psb_cgelpv + diff --git a/base/serial/psb_dgelp.f90 b/base/serial/psb_dgelp.f90 new file mode 100644 index 000000000..050f07f3c --- /dev/null +++ b/base/serial/psb_dgelp.f90 @@ -0,0 +1,258 @@ +!!$ +!!$ Parallel Sparse BLAS version 2.2 +!!$ (C) Copyright 2006/2007/2008 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +! File: psb_dgelp.f90 +! +! +! Subroutine: psb_dgelp +! Apply a left permutation to a dense matrix +! +! Arguments: +! trans - character. +! iperm - integer. +! x - real, dimension(:,:). +! info - integer. Return code. +subroutine psb_dgelp(trans,iperm,x,info) + use psb_serial_mod, psb_protect_name => psb_dgelp + use psb_const_mod + use psb_error_mod + implicit none + + real(psb_dpk_), intent(inout) :: x(:,:) + integer, intent(in) :: iperm(:) + integer, intent(out) :: info + character, intent(in) :: trans + + ! local variables + real(psb_dpk_),allocatable :: temp(:) + integer :: int_err(5), i1sz, i2sz, err_act,i,j + integer, allocatable :: itemp(:) + real(psb_dpk_),parameter :: one=1 + integer :: debug_level, debug_unit + + character(len=20) :: name, ch_err + name = 'psb_dgelp' + + if(psb_get_errstatus() /= 0) return + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + i1sz = size(x,dim=1) + i2sz = size(x,dim=2) + + if (debug_level >= psb_debug_serial_)& + & write(debug_unit,*) trim(name),': size',i1sz,i2sz + + allocate(temp(i1sz),itemp(size(iperm)),stat=info) + if (info /= psb_success_) then + info=2040 + call psb_errpush(info,name) + goto 9999 + end if + itemp(:) = iperm(:) + + if (.not.psb_isaperm(i1sz,itemp)) then + info=psb_err_iarg_invalid_value_ + int_err(1) = 1 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + endif + select case( psb_toupper(trans)) + case('N') + do j=1,i2sz + do i=1,i1sz + temp(i) = x(itemp(i),j) + end do + do i=1,i1sz + x(i,j) = temp(i) + end do + end do + case('T') + do j=1,i2sz + do i=1,i1sz + temp(itemp(i)) = x(i,j) + end do + do i=1,i1sz + x(i,j) = temp(i) + end do + end do + case default + info=psb_err_from_subroutine_ + ch_err='dgelp' + call psb_errpush(info,name,a_err=ch_err) + end select + + deallocate(temp,itemp) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_ret_) then + return + else + call psb_error() + end if + return + +end subroutine psb_dgelp + + + +!!$ +!!$ Parallel Sparse BLAS version 2.2 +!!$ (C) Copyright 2006/2007/2008 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +! +! +! Subroutine: psb_dgelpv +! Apply a left permutation to a dense matrix +! +! Arguments: +! trans - character. +! iperm - integer. +! x - real, dimension(:). +! info - integer. Return code. +subroutine psb_dgelpv(trans,iperm,x,info) + use psb_serial_mod, psb_protect_name => psb_dgelpv + use psb_const_mod + use psb_error_mod + implicit none + + real(psb_dpk_), intent(inout) :: x(:) + integer, intent(in) :: iperm(:) + integer, intent(out) :: info + character, intent(in) :: trans + + ! local variables + integer :: int_err(5), i1sz, err_act, i + real(psb_dpk_),allocatable :: temp(:) + integer, allocatable :: itemp(:) + real(psb_dpk_),parameter :: one=1 + integer :: debug_level, debug_unit + + character(len=20) :: name, ch_err + name = 'psb_dgelpv' + + if(psb_get_errstatus() /= 0) return + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + i1sz = min(size(x),size(iperm)) + + if (debug_level >= psb_debug_serial_)& + & write(debug_unit,*) trim(name),': size',i1sz + allocate(temp(i1sz),itemp(size(iperm)),stat=info) + if (info /= psb_success_) then + info=2040 + call psb_errpush(info,name) + goto 9999 + end if + itemp(:) = iperm(:) + + if (.not.psb_isaperm(i1sz,itemp)) then + info=psb_err_iarg_invalid_value_ + int_err(1) = 1 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + endif + + select case( psb_toupper(trans)) + case('N') + do i=1,i1sz + temp(i) = x(itemp(i)) + end do + do i=1,i1sz + x(i) = temp(i) + end do + case('T') + do i=1,i1sz + temp(itemp(i)) = x(i) + end do + do i=1,i1sz + x(i) = temp(i) + end do + case default + info=psb_err_from_subroutine_ + ch_err='dgelp' + call psb_errpush(info,name,a_err=ch_err) + end select + + deallocate(temp,itemp) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_ret_) then + return + else + call psb_error() + end if + return + +end subroutine psb_dgelpv + diff --git a/base/serial/psb_sgelp.f90 b/base/serial/psb_sgelp.f90 new file mode 100644 index 000000000..63454d29c --- /dev/null +++ b/base/serial/psb_sgelp.f90 @@ -0,0 +1,259 @@ +!!$ +!!$ Parallel Sparse BLAS version 2.2 +!!$ (C) Copyright 2006/2007/2008 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +! File: psb_sgelp.f90 +! +! +! Subroutine: psb_sgelp +! Apply a left permutation to a dense matrix +! +! Arguments: +! trans - character. +! iperm - integer. +! x - real, dimension(:,:). +! info - integer. Return code. +subroutine psb_sgelp(trans,iperm,x,info) + use psb_serial_mod, psb_protect_name => psb_sgelp + use psb_const_mod + use psb_error_mod + implicit none + + real(psb_spk_), intent(inout) :: x(:,:) + integer, intent(in) :: iperm(:) + integer, intent(out) :: info + character, intent(in) :: trans + ! local variables + integer :: ictxt + real(psb_spk_),allocatable :: temp(:) + integer :: int_err(5), i1sz, i2sz, err_act,i,j + integer, allocatable :: itemp(:) + real(psb_spk_),parameter :: one=1 + integer :: debug_level, debug_unit + + character(len=20) :: name, ch_err + name = 'psb_sgelp' + + if(psb_get_errstatus() /= 0) return + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + i1sz = size(x,dim=1) + i2sz = size(x,dim=2) + + if (debug_level >= psb_debug_serial_)& + & write(debug_unit,*) trim(name),': size',i1sz,i2sz + + allocate(temp(i1sz),itemp(size(iperm)),stat=info) + if (info /= psb_success_) then + info=2040 + call psb_errpush(info,name) + goto 9999 + end if + itemp(:) = iperm(:) + + if (.not.psb_isaperm(i1sz,itemp)) then + info=psb_err_iarg_invalid_value_ + int_err(1) = 1 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + endif + select case( psb_toupper(trans)) + case('N') + do j=1,i2sz + do i=1,i1sz + temp(i) = x(itemp(i),j) + end do + do i=1,i1sz + x(i,j) = temp(i) + end do + end do + case('T') + do j=1,i2sz + do i=1,i1sz + temp(itemp(i)) = x(i,j) + end do + do i=1,i1sz + x(i,j) = temp(i) + end do + end do + case default + info=psb_err_from_subroutine_ + ch_err='dgelp' + call psb_errpush(info,name,a_err=ch_err) + end select + + deallocate(temp,itemp) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_ret_) then + return + else + call psb_error(ictxt) + end if + return + +end subroutine psb_sgelp + + + +!!$ +!!$ Parallel Sparse BLAS version 2.2 +!!$ (C) Copyright 2006/2007/2008 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +! +! +! Subroutine: psb_sgelpv +! Apply a left permutation to a dense matrix +! +! Arguments: +! trans - character. +! iperm - integer. +! x - real, dimension(:). +! info - integer. Return code. +subroutine psb_sgelpv(trans,iperm,x,info) + use psb_serial_mod, psb_protect_name => psb_sgelpv + use psb_const_mod + use psb_error_mod + implicit none + + real(psb_spk_), intent(inout) :: x(:) + integer, intent(in) :: iperm(:) + integer, intent(out) :: info + character, intent(in) :: trans + + ! local variables + integer :: ictxt + integer :: int_err(5), i1sz, err_act, i + real(psb_spk_),allocatable :: temp(:) + integer, allocatable :: itemp(:) + real(psb_spk_),parameter :: one=1 + integer :: debug_level, debug_unit + + character(len=20) :: name, ch_err + name = 'psb_sgelpv' + + if(psb_get_errstatus() /= 0) return + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + i1sz = min(size(x),size(iperm)) + + if (debug_level >= psb_debug_serial_)& + & write(debug_unit,*) trim(name),': size',i1sz + allocate(temp(i1sz),itemp(size(iperm)),stat=info) + if (info /= psb_success_) then + info=2040 + call psb_errpush(info,name) + goto 9999 + end if + itemp(:) = iperm(:) + + if (.not.psb_isaperm(i1sz,itemp)) then + info=psb_err_iarg_invalid_value_ + int_err(1) = 1 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + endif + + select case( psb_toupper(trans)) + case('N') + do i=1,i1sz + temp(i) = x(itemp(i)) + end do + do i=1,i1sz + x(i) = temp(i) + end do + case('T') + do i=1,i1sz + temp(itemp(i)) = x(i) + end do + do i=1,i1sz + x(i) = temp(i) + end do + case default + info=psb_err_from_subroutine_ + ch_err='dgelp' + call psb_errpush(info,name,a_err=ch_err) + end select + + deallocate(temp,itemp) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_ret_) then + return + else + call psb_error(ictxt) + end if + return + +end subroutine psb_sgelpv + diff --git a/base/serial/psb_spdot_srtd.f90 b/base/serial/psb_spdot_srtd.f90 index e45c76667..d17994b16 100644 --- a/base/serial/psb_spdot_srtd.f90 +++ b/base/serial/psb_spdot_srtd.f90 @@ -235,27 +235,41 @@ function psb_d_spdot_srtd(nv1,iv1,v1,nv2,iv2,v2) result(dot) use psb_const_mod integer, intent(in) :: nv1,nv2 integer, intent(in) :: iv1(*), iv2(*) - real(psb_dpk_), intent(in) :: v1(*),v2(*) + real(psb_dpk_), intent(in) :: v1(*), v2(*) real(psb_dpk_) :: dot - integer :: i,j,k, ip1, ip2 + integer :: i,j,k, ip1, ip2, im1, im2, ix1, ix2 dot = dzero ip1 = 1 ip2 = 1 if (nv1 == 0) return if (nv2 == 0) return + im1 = iv1(nv1) + im2 = iv2(nv2) + ix1 = iv1(ip1) + ix2 = iv2(ip2) do - if (iv1(ip1) == iv2(ip2)) then + if (ix1>im2) exit + if (ix2>im1) exit + + if (ix1 == ix2) then dot = dot + v1(ip1)*v2(ip2) ip1 = ip1 + 1 + if (ip1 > nv1) exit + ix1 = iv1(ip1) ip2 = ip2 + 1 - else if (iv1(ip1) < iv2(ip2)) then + if (ip2 > nv2) exit + ix2 = iv2(ip2) + else if (ix1 < ix2) then ip1 = ip1 + 1 + if (ip1 > nv1) exit + ix1 = iv1(ip1) else ip2 = ip2 + 1 + if (ip2 > nv2) exit + ix2 = iv2(ip2) end if - if ((ip1 > nv1) .or. (ip2 > nv2)) exit end do end function psb_d_spdot_srtd diff --git a/base/serial/psb_zgelp.f90 b/base/serial/psb_zgelp.f90 new file mode 100644 index 000000000..0db1a7f45 --- /dev/null +++ b/base/serial/psb_zgelp.f90 @@ -0,0 +1,258 @@ +!!$ +!!$ Parallel Sparse BLAS version 2.2 +!!$ (C) Copyright 2006/2007/2008 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +! File: psb_zgelp.f90 +! +! +! Subroutine: psb_zgelp +! Apply a left permutation to a dense matrix +! +! Arguments: +! trans - character. +! iperm - integer. +! x - real, dimension(:,:). +! info - integer. Return code. +subroutine psb_zgelp(trans,iperm,x,info) + use psb_serial_mod, psb_protect_name => psb_zgelp + use psb_const_mod + use psb_error_mod + implicit none + + complex(psb_dpk_), intent(inout) :: x(:,:) + integer, intent(in) :: iperm(:) + integer, intent(out) :: info + character, intent(in) :: trans + + ! local variables + complex(psb_dpk_),allocatable :: temp(:) + integer :: int_err(5), i1sz, i2sz, err_act,i,j + integer, allocatable :: itemp(:) + complex(psb_dpk_),parameter :: one=1 + integer :: debug_level, debug_unit + + character(len=20) :: name, ch_err + name = 'psb_zgelp' + + if(psb_get_errstatus() /= 0) return + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + i1sz = size(x,dim=1) + i2sz = size(x,dim=2) + + if (debug_level >= psb_debug_serial_)& + & write(debug_unit,*) trim(name),': size',i1sz,i2sz + + allocate(temp(i1sz),itemp(size(iperm)),stat=info) + if (info /= psb_success_) then + info=2040 + call psb_errpush(info,name) + goto 9999 + end if + itemp(:) = iperm(:) + + if (.not.psb_isaperm(i1sz,itemp)) then + info=psb_err_iarg_invalid_value_ + int_err(1) = 1 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + endif + select case( psb_toupper(trans)) + case('N') + do j=1,i2sz + do i=1,i1sz + temp(i) = x(itemp(i),j) + end do + do i=1,i1sz + x(i,j) = temp(i) + end do + end do + case('T') + do j=1,i2sz + do i=1,i1sz + temp(itemp(i)) = x(i,j) + end do + do i=1,i1sz + x(i,j) = temp(i) + end do + end do + case default + info=psb_err_from_subroutine_ + ch_err='dgelp' + call psb_errpush(info,name,a_err=ch_err) + end select + + deallocate(temp,itemp) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_ret_) then + return + else + call psb_error() + end if + return + +end subroutine psb_zgelp + + + +!!$ +!!$ Parallel Sparse BLAS version 2.2 +!!$ (C) Copyright 2006/2007/2008 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +! +! +! Subroutine: psb_zgelpv +! Apply a left permutation to a dense matrix +! +! Arguments: +! trans - character. +! iperm - integer. +! x - real, dimension(:). +! info - integer. Return code. +subroutine psb_zgelpv(trans,iperm,x,info) + use psb_serial_mod, psb_protect_name => psb_zgelpv + use psb_const_mod + use psb_error_mod + implicit none + + complex(psb_dpk_), intent(inout) :: x(:) + integer, intent(in) :: iperm(:) + integer, intent(out) :: info + character, intent(in) :: trans + + ! local variables + integer :: int_err(5), i1sz, err_act, i + complex(psb_dpk_),allocatable :: temp(:) + integer, allocatable :: itemp(:) + complex(psb_dpk_),parameter :: one=1 + integer :: debug_level, debug_unit + + character(len=20) :: name, ch_err + name = 'psb_zgelpv' + + if(psb_get_errstatus() /= 0) return + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + i1sz = min(size(x),size(iperm)) + + if (debug_level >= psb_debug_serial_)& + & write(debug_unit,*) trim(name),': size',i1sz + allocate(temp(i1sz),itemp(size(iperm)),stat=info) + if (info /= psb_success_) then + info=2040 + call psb_errpush(info,name) + goto 9999 + end if + itemp(:) = iperm(:) + + if (.not.psb_isaperm(i1sz,itemp)) then + info=psb_err_iarg_invalid_value_ + int_err(1) = 1 + call psb_errpush(info,name,i_err=int_err) + goto 9999 + endif + + select case( psb_toupper(trans)) + case('N') + do i=1,i1sz + temp(i) = x(itemp(i)) + end do + do i=1,i1sz + x(i) = temp(i) + end do + case('T') + do i=1,i1sz + temp(itemp(i)) = x(i) + end do + do i=1,i1sz + x(i) = temp(i) + end do + case default + info=psb_err_from_subroutine_ + ch_err='dgelp' + call psb_errpush(info,name,a_err=ch_err) + end select + + deallocate(temp,itemp) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_ret_) then + return + else + call psb_error() + end if + return + +end subroutine psb_zgelpv + diff --git a/base/tools/Makefile b/base/tools/Makefile index 4befdd402..2a63fbac2 100644 --- a/base/tools/Makefile +++ b/base/tools/Makefile @@ -18,7 +18,8 @@ FOBJS = psb_sallc.o psb_sasb.o \ psb_zspins.o psb_zsprn.o \ psb_cspalloc.o psb_cspasb.o psb_cspfree.o\ psb_callc.o psb_casb.o psb_cfree.o psb_cins.o \ - psb_cspins.o psb_csprn.o psb_cd_set_bld.o psb_linmap.o psb_map.o + psb_cspins.o psb_csprn.o psb_cd_set_bld.o \ + psb_s_map.o psb_d_map.o psb_c_map.o psb_z_map.o MPFOBJS = psb_icdasb.o psb_ssphalo.o psb_dsphalo.o psb_csphalo.o psb_zsphalo.o \ psb_dcdbldext.o psb_zcdbldext.o psb_scdbldext.o psb_ccdbldext.o diff --git a/base/tools/psb_c_map.f90 b/base/tools/psb_c_map.f90 new file mode 100644 index 000000000..7d0a3f670 --- /dev/null +++ b/base/tools/psb_c_map.f90 @@ -0,0 +1,439 @@ +!!$ +!!$ Parallel Sparse BLAS version 3.0 +!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +!!$ +! +! +! +! Takes a vector x from space map%p_desc_X and maps it onto +! map%p_desc_Y under map%map_X2Y possibly with communication +! due to exch_fw_idx +! +subroutine psb_c_map_X2Y(alpha,x,beta,y,map,info,work) + use psb_base_mod, psb_protect_name => psb_c_map_X2Y + + implicit none + type(psb_clinmap_type), intent(in) :: map + complex(psb_spk_), intent(in) :: alpha,beta + complex(psb_spk_), intent(inout) :: x(:) + complex(psb_spk_), intent(out) :: y(:) + integer, intent(out) :: info + complex(psb_spk_), optional :: work(:) + + ! + complex(psb_spk_), allocatable :: xt(:), yt(:) + integer :: i, j, nr1, nc1,nr2, nc2,& + & map_kind, map_data, nr, ictxt + character(len=20), parameter :: name='psb_map_X2Y' + + info = psb_success_ + if (.not.psb_is_asb_map(map)) then + write(psb_err_unit,*) trim(name),' Invalid descriptor input' + info = 1 + return + end if + + map_kind = psb_get_map_kind(map) + + select case(map_kind) + case(psb_map_aggr_) + + ictxt = map%p_desc_Y%get_context() + nr2 = map%p_desc_Y%get_global_rows() + nc2 = map%p_desc_Y%get_local_cols() + allocate(yt(nc2),stat=info) + if (info == psb_success_) call psb_halo(x,map%p_desc_X,info,work=work) + if (info == psb_success_) call psb_csmm(cone,map%map_X2Y,x,czero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_Y)) then + call psb_sum(ictxt,yt(1:nr2)) + end if + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_Y,info) + if (info /= psb_success_) then + write(psb_err_unit,*) trim(name),' Error from inner routines',info + info = -1 + end if + + case(psb_map_gen_linear_) + + ictxt = map%desc_Y%get_context() + nr1 = map%desc_X%get_local_rows() + nc1 = map%desc_X%get_local_cols() + nr2 = map%desc_Y%get_global_rows() + nc2 = map%desc_Y%get_local_cols() + allocate(xt(nc1),yt(nc2),stat=info) + xt(1:nr1) = x(1:nr1) + if (info == psb_success_) call psb_halo(xt,map%desc_X,info,work=work) + if (info == psb_success_) call psb_csmm(cone,map%map_X2Y,xt,czero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_Y)) then + call psb_sum(ictxt,yt(1:nr2)) + end if + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_Y,info) + if (info /= psb_success_) then + write(psb_err_unit,*) trim(name),' Error from inner routines',info + info = -1 + end if + + + case default + write(psb_err_unit,*) trim(name),' Invalid descriptor input' + info = 1 + return + end select + +end subroutine psb_c_map_X2Y + + +subroutine psb_c_map_X2Y_vect(alpha,x,beta,y,map,info,work) + use psb_base_mod, psb_protect_name => psb_c_map_X2Y_vect + implicit none + type(psb_clinmap_type), intent(in) :: map + complex(psb_spk_), intent(in) :: alpha,beta + type(psb_c_vect_type), intent(inout) :: x,y + integer, intent(out) :: info + complex(psb_spk_), optional :: work(:) + ! Local + type(psb_c_vect_type) :: xt, yt + complex(psb_spk_), allocatable :: xta(:), yta(:) + integer :: i, j, nr1, nc1,nr2, nc2 ,& + & map_kind, map_data, nr, ictxt + character(len=20), parameter :: name='psb_map_X2Y' + + info = psb_success_ + if (.not.psb_is_asb_map(map)) then + write(psb_err_unit,*) trim(name),' Invalid descriptor input: unassembled' + info = 1 + return + end if + + map_kind = psb_get_map_kind(map) + + select case(map_kind) + case(psb_map_aggr_) + + ictxt = map%p_desc_Y%get_context() + nr2 = map%p_desc_Y%get_global_rows() + nc2 = map%p_desc_Y%get_local_cols() + call psb_geall(yt,map%p_desc_Y,info) + call psb_geasb(yt,map%p_desc_Y,info,mold=y%v) + if (info == psb_success_) call psb_halo(x,map%p_desc_X,info,work=work) + if (info == psb_success_) call psb_csmm(cone,map%map_X2Y,x,czero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_Y)) then + yta = yt + call psb_sum(ictxt,yta(1:nr2)) + call yt%set(yta) + end if + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_Y,info) + if (info /= psb_success_) then + write(psb_err_unit,*) trim(name),' Error from inner routines',info + info = -1 + end if + call psb_gefree(yt,map%p_desc_Y,info) + + case(psb_map_gen_linear_) + + ictxt = map%desc_Y%get_context() + nr1 = map%desc_X%get_local_rows() + nc1 = map%desc_X%get_local_cols() + nr2 = map%desc_Y%get_global_rows() + nc2 = map%desc_Y%get_local_cols() + + call psb_geall(xt,map%p_desc_X,info) + call psb_geasb(xt,map%p_desc_X,info,mold=x%v) + call psb_geall(yt,map%p_desc_Y,info) + call psb_geasb(yt,map%p_desc_Y,info,mold=y%v) + xta = x + call xt%set(xta(1:nr1)) + if (info == psb_success_) call psb_halo(xt,map%desc_X,info,work=work) + if (info == psb_success_) call psb_csmm(cone,map%map_X2Y,xt,czero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_Y)) then + yta = yt + call psb_sum(ictxt,yta(1:nr2)) + call yt%set(yta) + end if + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_Y,info) + if (info /= psb_success_) then + write(psb_err_unit,*) trim(name),' Error from inner routines',info + info = -1 + end if + + call psb_gefree(xt,map%p_desc_Y,info) + call psb_gefree(yt,map%p_desc_Y,info) + + case default + write(psb_err_unit,*) trim(name),' Invalid descriptor input', & + & map_kind, psb_map_aggr_, psb_map_gen_linear_ + info = 1 + return + end select + + return +end subroutine psb_c_map_X2Y_vect + + +! +! Takes a vector x from space map%p_desc_Y and maps it onto +! map%p_desc_X under map%map_Y2X possibly with communication +! due to exch_bk_idx +! +subroutine psb_c_map_Y2X(alpha,x,beta,y,map,info,work) + use psb_base_mod, psb_protect_name => psb_c_map_Y2X + + implicit none + type(psb_clinmap_type), intent(in) :: map + complex(psb_spk_), intent(in) :: alpha,beta + complex(psb_spk_), intent(inout) :: x(:) + complex(psb_spk_), intent(out) :: y(:) + integer, intent(out) :: info + complex(psb_spk_), optional :: work(:) + + ! + complex(psb_spk_), allocatable :: xt(:), yt(:) + integer :: i, j, nr1, nc1,nr2, nc2,& + & map_kind, map_data, nr, ictxt + character(len=20), parameter :: name='psb_map_Y2X' + + info = psb_success_ + if (.not.psb_is_asb_map(map)) then + write(psb_err_unit,*) trim(name),' Invalid descriptor input' + info = 1 + return + end if + + map_kind = psb_get_map_kind(map) + + select case(map_kind) + case(psb_map_aggr_) + + ictxt = map%p_desc_X%get_context() + nr2 = map%p_desc_X%get_global_rows() + nc2 = map%p_desc_X%get_local_cols() + allocate(yt(nc2),stat=info) + if (info == psb_success_) call psb_halo(x,map%p_desc_Y,info,work=work) + if (info == psb_success_) call psb_csmm(cone,map%map_Y2X,x,czero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_X)) then + call psb_sum(ictxt,yt(1:nr2)) + end if + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_X,info) + if (info /= psb_success_) then + write(psb_err_unit,*) trim(name),' Error from inner routines',info + info = -1 + end if + + case(psb_map_gen_linear_) + + ictxt = map%desc_X%get_context() + nr1 = map%desc_Y%get_local_rows() + nc1 = map%desc_Y%get_local_cols() + nr2 = map%desc_X%get_global_rows() + nc2 = map%desc_X%get_local_cols() + allocate(xt(nc1),yt(nc2),stat=info) + xt(1:nr1) = x(1:nr1) + if (info == psb_success_) call psb_halo(xt,map%desc_Y,info,work=work) + if (info == psb_success_) call psb_csmm(cone,map%map_Y2X,xt,czero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_X)) then + call psb_sum(ictxt,yt(1:nr2)) + end if + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_X,info) + if (info /= psb_success_) then + write(psb_err_unit,*) trim(name),' Error from inner routines',info + info = -1 + end if + + + case default + write(psb_err_unit,*) trim(name),' Invalid descriptor input' + info = 1 + return + end select + +end subroutine psb_c_map_Y2X + +subroutine psb_c_map_Y2X_vect(alpha,x,beta,y,map,info,work) + use psb_base_mod, psb_protect_name => psb_c_map_Y2X_vect + implicit none + type(psb_clinmap_type), intent(in) :: map + complex(psb_spk_), intent(in) :: alpha,beta + type(psb_c_vect_type), intent(inout) :: x,y + integer, intent(out) :: info + complex(psb_spk_), optional :: work(:) + ! + type(psb_c_vect_type) :: xt, yt + complex(psb_spk_), allocatable :: xta(:), yta(:) + integer :: i, j, nr1, nc1,nr2, nc2,& + & map_kind, map_data, nr, ictxt + character(len=20), parameter :: name='psb_map_Y2X' + + info = psb_success_ + if (.not.psb_is_asb_map(map)) then + write(psb_err_unit,*) trim(name),' Invalid descriptor input' + info = 1 + return + end if + + map_kind = psb_get_map_kind(map) + + select case(map_kind) + case(psb_map_aggr_) + + ictxt = map%p_desc_X%get_context() + nr2 = map%p_desc_X%get_global_rows() + nc2 = map%p_desc_X%get_local_cols() + call psb_geall(yt,map%p_desc_X,info) + call psb_geasb(yt,map%p_desc_X,info,mold=y%v) + if (info == psb_success_) call psb_halo(x,map%p_desc_Y,info,work=work) + if (info == psb_success_) call psb_csmm(cone,map%map_Y2X,x,czero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_X)) then + yta = yt + call psb_sum(ictxt,yta(1:nr2)) + call yt%set(yta) + end if + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_X,info) + if (info /= psb_success_) then + write(psb_err_unit,*) trim(name),' Error from inner routines',info + info = -1 + end if + call psb_gefree(yt,map%p_desc_Y,info) + + case(psb_map_gen_linear_) + + ictxt = map%desc_X%get_context() + nr1 = map%desc_Y%get_local_rows() + nc1 = map%desc_Y%get_local_cols() + nr2 = map%desc_X%get_global_rows() + nc2 = map%desc_X%get_local_cols() + + call psb_geall(xt,map%p_desc_Y,info) + call psb_geasb(xt,map%p_desc_Y,info,mold=x%v) + call psb_geall(yt,map%p_desc_X,info) + call psb_geasb(yt,map%p_desc_X,info,mold=y%v) + + xta = x + call xt%set(xta(1:nr1)) + + if (info == psb_success_) call psb_halo(xt,map%desc_Y,info,work=work) + if (info == psb_success_) call psb_csmm(cone,map%map_Y2X,xt,czero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_X)) then + yta = yt + call psb_sum(ictxt,yta(1:nr2)) + call yt%set(yta) + end if + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_X,info) + if (info /= psb_success_) then + write(psb_err_unit,*) trim(name),' Error from inner routines',info + info = -1 + end if + + call psb_gefree(xt,map%p_desc_Y,info) + call psb_gefree(yt,map%p_desc_Y,info) + + case default + write(psb_err_unit,*) trim(name),' Invalid descriptor input' + info = 1 + return + end select + +end subroutine psb_c_map_Y2X_vect + +function psb_c_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) result(this) + + use psb_base_mod, psb_protect_name => psb_c_linmap + + implicit none + type(psb_clinmap_type) :: this + type(psb_desc_type), target :: desc_X, desc_Y + type(psb_cspmat_type), intent(in) :: map_X2Y, map_Y2X + integer, intent(in) :: map_kind + integer, intent(in), optional :: iaggr(:), naggr(:) + ! + integer :: info + character(len=20), parameter :: name='psb_linmap' + + info = psb_success_ + select case(map_kind) + case (psb_map_aggr_) + ! OK + if (psb_is_ok_desc(desc_X)) then + this%p_desc_X=>desc_X + else + info = psb_err_pivot_too_small_ + endif + if (psb_is_ok_desc(desc_Y)) then + this%p_desc_Y=>desc_Y + else + info = psb_err_invalid_ovr_num_ + endif + if (present(iaggr)) then + if (.not.present(naggr)) then + info = 7 + else + allocate(this%iaggr(size(iaggr)),& + & this%naggr(size(naggr)), stat=info) + if (info == psb_success_) then + this%iaggr(:) = iaggr(:) + this%naggr(:) = naggr(:) + end if + end if + else + allocate(this%iaggr(0), this%naggr(0), stat=info) + end if + + case(psb_map_gen_linear_) + + if (psb_is_ok_desc(desc_X)) then + call psb_cdcpy(desc_X, this%desc_X,info) + else + info = psb_err_pivot_too_small_ + endif + if (psb_is_ok_desc(desc_Y)) then + call psb_cdcpy(desc_Y, this%desc_Y,info) + else + info = psb_err_invalid_ovr_num_ + endif + ! For a general linear map ignore iaggr,naggr + allocate(this%iaggr(0), this%naggr(0), stat=info) + + case default + write(psb_err_unit,*) 'Bad map kind into psb_linmap ',map_kind + info = 1 + end select + + if (info == psb_success_) call psb_clone(map_X2Y,this%map_X2Y,info) + if (info == psb_success_) call psb_clone(map_Y2X,this%map_Y2X,info) + if (info == psb_success_) call psb_realloc(psb_itd_data_size_,this%itd_data,info) + if (info == psb_success_) then + call psb_set_map_kind(map_kind, this) + end if + if (info /= psb_success_) then + write(psb_err_unit,*) trim(name),' Invalid descriptor input' + return + end if + +end function psb_c_linmap diff --git a/base/tools/psb_callc.f90 b/base/tools/psb_callc.f90 index 0b2fdb475..56cbd1009 100644 --- a/base/tools/psb_callc.f90 +++ b/base/tools/psb_callc.f90 @@ -252,3 +252,186 @@ subroutine psb_callocv(x, desc_a,info,n) end subroutine psb_callocv +subroutine psb_calloc_vect(x, desc_a,info,n) + use psb_base_mod, psb_protect_name => psb_calloc_vect + use psi_mod + implicit none + + !....parameters... + type(psb_c_vect_type), intent(out) :: x + type(psb_desc_type), intent(in) :: desc_a + integer,intent(out) :: info + integer, optional, intent(in) :: n + + !locals + integer :: np,me,nr,i,err_act + integer :: ictxt, int_err(5) + integer :: debug_level, debug_unit + character(len=20) :: name + + info=psb_success_ + if (psb_errstatus_fatal()) return + name='psb_geall' + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt=desc_a%get_context() + + call psb_info(ictxt, me, np) + ! ....verify blacs grid correctness.. + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + !... check m and n parameters.... + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if + + ! As this is a rank-1 array, optional parameter N is actually ignored. + + !....allocate x ..... + if (psb_is_asb_desc(desc_a).or.psb_is_upd_desc(desc_a)) then + nr = max(1,desc_a%get_local_cols()) + else if (psb_is_bld_desc(desc_a)) then + nr = max(1,desc_a%get_local_rows()) + else + info = psb_err_internal_error_ + call psb_errpush(info,name,int_err,a_err='Invalid desc_a') + goto 9999 + endif + + allocate(psb_c_base_vect_type :: x%v, stat=info) + if (info == 0) call x%all(nr,info) + if (psb_errstatus_fatal()) then + info=psb_err_alloc_request_ + int_err(1)=nr + call psb_errpush(info,name,int_err,a_err='real(psb_spk_)') + goto 9999 + endif + call x%zero() + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end subroutine psb_calloc_vect + +subroutine psb_calloc_vect_r2(x, desc_a,info,n,lb) + use psb_base_mod, psb_protect_name => psb_calloc_vect_r2 + use psi_mod + implicit none + + !....parameters... + type(psb_c_vect_type), allocatable, intent(out) :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer,intent(out) :: info + integer, optional, intent(in) :: n,lb + + !locals + integer :: np,me,nr,i,err_act, n_, lb_ + integer :: ictxt, int_err(5), exch(1) + integer :: debug_level, debug_unit + character(len=20) :: name + + info=psb_success_ + if (psb_errstatus_fatal()) return + name='psb_geall' + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt=desc_a%get_context() + + call psb_info(ictxt, me, np) + ! ....verify blacs grid correctness.. + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + !... check m and n parameters.... + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if + + if (present(n)) then + n_ = n + else + n_ = 1 + endif + if (present(lb)) then + lb_ = lb + else + lb_ = 1 + endif + + !global check on n parameters + if (me == psb_root_) then + exch(1)=n_ + call psb_bcast(ictxt,exch(1),root=psb_root_) + else + call psb_bcast(ictxt,exch(1),root=psb_root_) + if (exch(1) /= n_) then + info=psb_err_parm_differs_among_procs_ + int_err(1)=1 + call psb_errpush(info,name,int_err) + goto 9999 + endif + endif + ! As this is a rank-1 array, optional parameter N is actually ignored. + + !....allocate x ..... + if (desc_a%is_asb().or.desc_a%is_upd()) then + nr = max(1,desc_a%get_local_cols()) + else if (desc_a%is_bld()) then + nr = max(1,desc_a%get_local_rows()) + else + info = psb_err_internal_error_ + call psb_errpush(info,name,int_err,a_err='Invalid desc_a') + goto 9999 + endif + + allocate(x(lb_:lb_+n_-1), stat=info) + if (info == 0) then + do i=lb_, lb_+n_-1 + allocate(psb_c_base_vect_type :: x(i)%v, stat=info) + if (info == 0) call x(i)%all(nr,info) + if (info == 0) call x(i)%zero() + if (info /= 0) exit + end do + end if + if (psb_errstatus_fatal()) then + info=psb_err_alloc_request_ + int_err(1)=nr + call psb_errpush(info,name,int_err,a_err='real(psb_spk_)') + goto 9999 + endif + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end subroutine psb_calloc_vect_r2 diff --git a/base/tools/psb_casb.f90 b/base/tools/psb_casb.f90 index 454bf13ed..54bbdd22f 100644 --- a/base/tools/psb_casb.f90 +++ b/base/tools/psb_casb.f90 @@ -250,3 +250,148 @@ subroutine psb_casbv(x, desc_a, info) end subroutine psb_casbv +subroutine psb_casb_vect(x, desc_a, info, mold) + use psb_base_mod, psb_protect_name => psb_casb_vect + implicit none + + type(psb_desc_type), intent(in) :: desc_a + type(psb_c_vect_type), intent(inout) :: x + integer, intent(out) :: info + class(psb_c_base_vect_type), intent(in), optional :: mold + + ! local variables + integer :: ictxt,np,me + integer :: int_err(5), i1sz,nrow,ncol, err_act + integer :: debug_level, debug_unit + character(len=20) :: name,ch_err + + info = psb_success_ + if (psb_errstatus_fatal()) return + + int_err(1) = 0 + name = 'psb_cgeasb_v' + + ictxt = desc_a%get_context() + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + call psb_info(ictxt, me, np) + + ! ....verify blacs grid correctness.. + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + else if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if + + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),': sizes: ',nrow,ncol + + call x%asb(ncol,info) + ! ..update halo elements.. + call psb_halo(x,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_halo') + goto 9999 + end if + if (present(mold)) then + call x%cnv(mold) + end if + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),': end' + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end subroutine psb_casb_vect + + +subroutine psb_casb_vect_r2(x, desc_a, info, mold) + use psb_base_mod, psb_protect_name => psb_casb_vect_r2 + implicit none + + type(psb_desc_type), intent(in) :: desc_a + type(psb_c_vect_type), intent(inout) :: x(:) + integer, intent(out) :: info + class(psb_c_base_vect_type), intent(in), optional :: mold + + ! local variables + integer :: ictxt,np,me, i, n + integer :: int_err(5), i1sz,nrow,ncol, err_act + integer :: debug_level, debug_unit + character(len=20) :: name,ch_err + + info = psb_success_ + if (psb_errstatus_fatal()) return + + int_err(1) = 0 + name = 'psb_cgeasb_v' + + ictxt = desc_a%get_context() + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + call psb_info(ictxt, me, np) + + ! ....verify blacs grid correctness.. + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + else if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if + + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + n = size(x) + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),': sizes: ',nrow,ncol + + do i=1, n + call x(i)%asb(ncol,info) + if (info /= 0) exit + ! ..update halo elements.. + call psb_halo(x(i),desc_a,info) + if (info /= 0) exit + if (present(mold)) then + call x(i)%cnv(mold) + end if + end do + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_halo') + goto 9999 + end if + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),': end' + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end subroutine psb_casb_vect_r2 diff --git a/base/tools/psb_cdins.f90 b/base/tools/psb_cdins.f90 index e3fceb33e..7053f921b 100644 --- a/base/tools/psb_cdins.f90 +++ b/base/tools/psb_cdins.f90 @@ -79,7 +79,7 @@ subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla) call psb_info(ictxt, me, np) - if (.not.psb_is_bld_desc(desc_a)) then + if (.not.desc_a%is_bld()) then info = psb_err_invalid_cd_state_ call psb_errpush(info,name) goto 9999 @@ -204,7 +204,7 @@ subroutine psb_cdinsc(nz,ja,desc,info,jla,mask) call psb_info(ictxt, me, np) - if (.not.psb_is_bld_desc(desc)) then + if (.not.desc%is_bld()) then info = psb_err_invalid_cd_state_ call psb_errpush(info,name) goto 9999 diff --git a/base/tools/psb_cfree.f90 b/base/tools/psb_cfree.f90 index d1989544c..649a9236c 100644 --- a/base/tools/psb_cfree.f90 +++ b/base/tools/psb_cfree.f90 @@ -170,3 +170,116 @@ subroutine psb_cfreev(x, desc_a, info) return end subroutine psb_cfreev + +subroutine psb_cfree_vect(x, desc_a, info) + use psb_base_mod, psb_protect_name => psb_cfree_vect + implicit none + !....parameters... + type(psb_c_vect_type), intent(inout) :: x + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + !...locals.... + integer :: ictxt,np,me,err_act + character(len=20) :: name + + + info=psb_success_ + if (psb_errstatus_fatal()) return + call psb_erractionsave(err_act) + name='psb_cfreev' + + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if + ictxt = desc_a%get_context() + + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + call x%free(info) + + if (info /= psb_no_err_) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + endif + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end subroutine psb_cfree_vect + +subroutine psb_cfree_vect_r2(x, desc_a, info) + use psb_base_mod, psb_protect_name => psb_cfree_vect_r2 + implicit none + !....parameters... + type(psb_c_vect_type), allocatable, intent(inout) :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + !...locals.... + integer :: ictxt,np,me,err_act, i + character(len=20) :: name + + + info=psb_success_ + if (psb_errstatus_fatal()) return + call psb_erractionsave(err_act) + name='psb_cfreev' + + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if + ictxt = desc_a%get_context() + + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + + do i=lbound(x,1),ubound(x,1) + call x(i)%free(info) + if (info /= 0) exit + end do + if (info == 0) deallocate(x,stat=info) + if (info /= psb_no_err_) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + endif + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end subroutine psb_cfree_vect_r2 diff --git a/base/tools/psb_cins.f90 b/base/tools/psb_cins.f90 index fcd5f8908..485abb16d 100644 --- a/base/tools/psb_cins.f90 +++ b/base/tools/psb_cins.f90 @@ -179,6 +179,231 @@ subroutine psb_cinsvi(m, irw, val, x, desc_a, info, dupl) end subroutine psb_cinsvi +subroutine psb_cins_vect(m, irw, val, x, desc_a, info, dupl) + use psb_base_mod, psb_protect_name => psb_cins_vect + use psi_mod + implicit none + + ! m rows number of submatrix belonging to val to be inserted + ! ix x global-row corresponding to position at which val submatrix + ! must be inserted + + !....parameters... + integer, intent(in) :: m + integer, intent(in) :: irw(:) + complex(psb_spk_), intent(in) :: val(:) + type(psb_c_vect_type), intent(inout) :: x + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, optional, intent(in) :: dupl + + !locals..... + integer :: ictxt,i,& + & loc_rows,loc_cols,mglob,err_act, int_err(5) + integer :: np, me, dupl_ + integer, allocatable :: irl(:) + character(len=20) :: name + + if (psb_errstatus_fatal()) return + info=psb_success_ + call psb_erractionsave(err_act) + name = 'psb_cinsvi' + + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if + + ictxt = desc_a%get_context() + + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + !... check parameters.... + if (m < 0) then + info = psb_err_iarg_neg_ + int_err(1) = 1 + int_err(2) = m + call psb_errpush(info,name,int_err) + goto 9999 + else if (x%get_nrows() < desc_a%get_local_rows()) then + info = 310 + int_err(1) = 5 + int_err(2) = 4 + call psb_errpush(info,name,int_err) + goto 9999 + endif + + if (m == 0) return + loc_rows = desc_a%get_local_rows() + loc_cols = desc_a%get_local_cols() + mglob = desc_a%get_global_rows() + + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + + allocate(irl(m),stat=info) + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + endif + + if (present(dupl)) then + dupl_ = dupl + else + dupl_ = psb_dupl_ovwrt_ + endif + + call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + + call x%ins(m,irl,val,dupl_,info) + if (info /= 0) then + call psb_errpush(info,name) + goto 9999 + end if + deallocate(irl) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_ret_) then + return + else + call psb_error(ictxt) + end if + return + +end subroutine psb_cins_vect + +subroutine psb_cins_vect_r2(m, irw, val, x, desc_a, info, dupl) + use psb_base_mod, psb_protect_name => psb_cins_vect_r2 + use psi_mod + implicit none + + ! m rows number of submatrix belonging to val to be inserted + ! ix x global-row corresponding to position at which val submatrix + ! must be inserted + + !....parameters... + integer, intent(in) :: m + integer, intent(in) :: irw(:) + complex(psb_spk_), intent(in) :: val(:,:) + type(psb_c_vect_type), intent(inout) :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, optional, intent(in) :: dupl + + !locals..... + integer :: ictxt,i,& + & loc_rows,loc_cols,mglob,err_act, int_err(5), n + integer :: np, me, dupl_ + integer, allocatable :: irl(:) + character(len=20) :: name + + if (psb_errstatus_fatal()) return + info=psb_success_ + call psb_erractionsave(err_act) + name = 'psb_cinsvi' + + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if + + ictxt = desc_a%get_context() + + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x(1)%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + !... check parameters.... + if (m < 0) then + info = psb_err_iarg_neg_ + int_err(1) = 1 + int_err(2) = m + call psb_errpush(info,name,int_err) + goto 9999 + else if (x(1)%get_nrows() < desc_a%get_local_rows()) then + info = 310 + int_err(1) = 5 + int_err(2) = 4 + call psb_errpush(info,name,int_err) + goto 9999 + endif + + if (m == 0) return + loc_rows = desc_a%get_local_rows() + loc_cols = desc_a%get_local_cols() + mglob = desc_a%get_global_rows() + + + + n = min(size(x),size(val,2)) + allocate(irl(m),stat=info) + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + endif + + if (present(dupl)) then + dupl_ = dupl + else + dupl_ = psb_dupl_ovwrt_ + endif + + call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + do i=1,n + if (.not.allocated(x(i)%v)) info = psb_err_invalid_vect_state_ + if (info == 0) call x(i)%ins(m,irl,val(:,i),dupl_,info) + if (info /= 0) exit + end do + if (info /= 0) then + call psb_errpush(info,name) + goto 9999 + end if + deallocate(irl) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_ret_) then + return + else + call psb_error(ictxt) + end if + return + +end subroutine psb_cins_vect_r2 + + + !!$ !!$ Parallel Sparse BLAS version 3.0 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 diff --git a/base/tools/psb_d_map.f90 b/base/tools/psb_d_map.f90 new file mode 100644 index 000000000..028d92e36 --- /dev/null +++ b/base/tools/psb_d_map.f90 @@ -0,0 +1,444 @@ +!!$ +!!$ Parallel Sparse BLAS version 3.0 +!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +!!$ +! +! +! +! Takes a vector x from space map%p_desc_X and maps it onto +! map%p_desc_Y under map%map_X2Y possibly with communication +! due to exch_fw_idx +! +subroutine psb_d_map_X2Y(alpha,x,beta,y,map,info,work) + use psb_base_mod, psb_protect_name => psb_d_map_X2Y + implicit none + type(psb_dlinmap_type), intent(in) :: map + real(psb_dpk_), intent(in) :: alpha,beta + real(psb_dpk_), intent(inout) :: x(:) + real(psb_dpk_), intent(out) :: y(:) + integer, intent(out) :: info + real(psb_dpk_), optional :: work(:) + + ! + real(psb_dpk_), allocatable :: xt(:), yt(:) + integer :: i, j, nr1, nc1,nr2, nc2 ,& + & map_kind, map_data, nr, ictxt + character(len=20), parameter :: name='psb_map_X2Y' + + info = psb_success_ + if (.not.psb_is_asb_map(map)) then + write(psb_err_unit,*) trim(name),' Invalid descriptor input: unassembled' + info = 1 + return + end if + + map_kind = psb_get_map_kind(map) + + select case(map_kind) + case(psb_map_aggr_) + + ictxt = map%p_desc_Y%get_context() + nr2 = map%p_desc_Y%get_global_rows() + nc2 = map%p_desc_Y%get_local_cols() + allocate(yt(nc2),stat=info) + if (info == psb_success_) call psb_halo(x,map%p_desc_X,info,work=work) + if (info == psb_success_) call psb_csmm(done,map%map_X2Y,x,dzero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_Y)) then + call psb_sum(ictxt,yt(1:nr2)) + end if + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_Y,info) + if (info /= psb_success_) then + write(psb_err_unit,*) trim(name),' Error from inner routines',info + info = -1 + end if + + case(psb_map_gen_linear_) + + ictxt = map%desc_Y%get_context() + nr1 = map%desc_X%get_local_rows() + nc1 = map%desc_X%get_local_cols() + nr2 = map%desc_Y%get_global_rows() + nc2 = map%desc_Y%get_local_cols() + allocate(xt(nc1),yt(nc2),stat=info) + xt(1:nr1) = x(1:nr1) + if (info == psb_success_) call psb_halo(xt,map%desc_X,info,work=work) + if (info == psb_success_) call psb_csmm(done,map%map_X2Y,xt,dzero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_Y)) then + call psb_sum(ictxt,yt(1:nr2)) + end if + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_Y,info) + if (info /= psb_success_) then + write(psb_err_unit,*) trim(name),' Error from inner routines',info + info = -1 + end if + + + case default + write(psb_err_unit,*) trim(name),' Invalid descriptor input', & + & map_kind, psb_map_aggr_, psb_map_gen_linear_ + info = 1 + return + end select + +end subroutine psb_d_map_X2Y + + +subroutine psb_d_map_X2Y_vect(alpha,x,beta,y,map,info,work) + use psb_base_mod, psb_protect_name => psb_d_map_X2Y_vect + implicit none + type(psb_dlinmap_type), intent(in) :: map + real(psb_dpk_), intent(in) :: alpha,beta + type(psb_d_vect_type), intent(inout) :: x,y + integer, intent(out) :: info + real(psb_dpk_), optional :: work(:) + ! Local + type(psb_d_vect_type) :: xt, yt + real(psb_dpk_), allocatable :: xta(:), yta(:) + integer :: i, j, nr1, nc1,nr2, nc2 ,& + & map_kind, map_data, nr, ictxt + character(len=20), parameter :: name='psb_map_X2Y' + + info = psb_success_ + if (.not.psb_is_asb_map(map)) then + write(psb_err_unit,*) trim(name),' Invalid descriptor input: unassembled' + info = 1 + return + end if + + map_kind = psb_get_map_kind(map) + + select case(map_kind) + case(psb_map_aggr_) + + ictxt = map%p_desc_Y%get_context() + nr2 = map%p_desc_Y%get_global_rows() + nc2 = map%p_desc_Y%get_local_cols() + call psb_geall(yt,map%p_desc_Y,info) + call psb_geasb(yt,map%p_desc_Y,info,mold=y%v) + if (info == psb_success_) call psb_halo(x,map%p_desc_X,info,work=work) + if (info == psb_success_) call psb_csmm(done,map%map_X2Y,x,dzero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_Y)) then + yta = yt + call psb_sum(ictxt,yta(1:nr2)) + call yt%set(yta) + end if + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_Y,info) + if (info /= psb_success_) then + write(psb_err_unit,*) trim(name),' Error from inner routines',info + info = -1 + end if + call psb_gefree(yt,map%p_desc_Y,info) + + case(psb_map_gen_linear_) + + ictxt = map%desc_Y%get_context() + nr1 = map%desc_X%get_local_rows() + nc1 = map%desc_X%get_local_cols() + nr2 = map%desc_Y%get_global_rows() + nc2 = map%desc_Y%get_local_cols() + + call psb_geall(xt,map%p_desc_X,info) + call psb_geasb(xt,map%p_desc_X,info,mold=x%v) + call psb_geall(yt,map%p_desc_Y,info) + call psb_geasb(yt,map%p_desc_Y,info,mold=y%v) + xta = x + call xt%set(xta(1:nr1)) + if (info == psb_success_) call psb_halo(xt,map%desc_X,info,work=work) + if (info == psb_success_) call psb_csmm(done,map%map_X2Y,xt,dzero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_Y)) then + yta = yt + call psb_sum(ictxt,yta(1:nr2)) + call yt%set(yta) + end if + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_Y,info) + if (info /= psb_success_) then + write(psb_err_unit,*) trim(name),' Error from inner routines',info + info = -1 + end if + + call psb_gefree(xt,map%p_desc_Y,info) + call psb_gefree(yt,map%p_desc_Y,info) + + case default + write(psb_err_unit,*) trim(name),' Invalid descriptor input', & + & map_kind, psb_map_aggr_, psb_map_gen_linear_ + info = 1 + return + end select + + return +end subroutine psb_d_map_X2Y_vect + + +! +! Takes a vector x from space map%p_desc_Y and maps it onto +! map%p_desc_X under map%map_Y2X possibly with communication +! due to exch_bk_idx +! +subroutine psb_d_map_Y2X(alpha,x,beta,y,map,info,work) + use psb_base_mod, psb_protect_name => psb_d_map_Y2X + + implicit none + type(psb_dlinmap_type), intent(in) :: map + real(psb_dpk_), intent(in) :: alpha,beta + real(psb_dpk_), intent(inout) :: x(:) + real(psb_dpk_), intent(out) :: y(:) + integer, intent(out) :: info + real(psb_dpk_), optional :: work(:) + + ! + real(psb_dpk_), allocatable :: xt(:), yt(:) + integer :: i, j, nr1, nc1,nr2, nc2,& + & map_kind, map_data, nr, ictxt + character(len=20), parameter :: name='psb_map_Y2X' + + info = psb_success_ + if (.not.psb_is_asb_map(map)) then + write(psb_err_unit,*) trim(name),' Invalid descriptor input' + info = 1 + return + end if + + map_kind = psb_get_map_kind(map) + + select case(map_kind) + case(psb_map_aggr_) + + ictxt = map%p_desc_X%get_context() + nr2 = map%p_desc_X%get_global_rows() + nc2 = map%p_desc_X%get_local_cols() + allocate(yt(nc2),stat=info) + if (info == psb_success_) call psb_halo(x,map%p_desc_Y,info,work=work) + if (info == psb_success_) call psb_csmm(done,map%map_Y2X,x,dzero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_X)) then + call psb_sum(ictxt,yt(1:nr2)) + end if + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_X,info) + if (info /= psb_success_) then + write(psb_err_unit,*) trim(name),' Error from inner routines',info + info = -1 + end if + + case(psb_map_gen_linear_) + + ictxt = map%desc_X%get_context() + nr1 = map%desc_Y%get_local_rows() + nc1 = map%desc_Y%get_local_cols() + nr2 = map%desc_X%get_global_rows() + nc2 = map%desc_X%get_local_cols() + allocate(xt(nc1),yt(nc2),stat=info) + xt(1:nr1) = x(1:nr1) + if (info == psb_success_) call psb_halo(xt,map%desc_Y,info,work=work) + if (info == psb_success_) call psb_csmm(done,map%map_Y2X,xt,dzero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_X)) then + call psb_sum(ictxt,yt(1:nr2)) + end if + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_X,info) + if (info /= psb_success_) then + write(psb_err_unit,*) trim(name),' Error from inner routines',info + info = -1 + end if + + + case default + write(psb_err_unit,*) trim(name),' Invalid descriptor input' + info = 1 + return + end select + +end subroutine psb_d_map_Y2X + +subroutine psb_d_map_Y2X_vect(alpha,x,beta,y,map,info,work) + use psb_base_mod, psb_protect_name => psb_d_map_Y2X_vect + implicit none + type(psb_dlinmap_type), intent(in) :: map + real(psb_dpk_), intent(in) :: alpha,beta + type(psb_d_vect_type), intent(inout) :: x,y + integer, intent(out) :: info + real(psb_dpk_), optional :: work(:) + ! + type(psb_d_vect_type) :: xt, yt + real(psb_dpk_), allocatable :: xta(:), yta(:) + integer :: i, j, nr1, nc1,nr2, nc2,& + & map_kind, map_data, nr, ictxt + character(len=20), parameter :: name='psb_map_Y2X' + + info = psb_success_ + if (.not.psb_is_asb_map(map)) then + write(psb_err_unit,*) trim(name),' Invalid descriptor input' + info = 1 + return + end if + + map_kind = psb_get_map_kind(map) + + select case(map_kind) + case(psb_map_aggr_) + + ictxt = map%p_desc_X%get_context() + nr2 = map%p_desc_X%get_global_rows() + nc2 = map%p_desc_X%get_local_cols() + call psb_geall(yt,map%p_desc_X,info) + call psb_geasb(yt,map%p_desc_X,info,mold=y%v) + if (info == psb_success_) call psb_halo(x,map%p_desc_Y,info,work=work) + if (info == psb_success_) call psb_csmm(done,map%map_Y2X,x,dzero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_X)) then + yta = yt + call psb_sum(ictxt,yta(1:nr2)) + call yt%set(yta) + end if + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_X,info) + if (info /= psb_success_) then + write(psb_err_unit,*) trim(name),' Error from inner routines',info + info = -1 + end if + call psb_gefree(yt,map%p_desc_Y,info) + + case(psb_map_gen_linear_) + + ictxt = map%desc_X%get_context() + nr1 = map%desc_Y%get_local_rows() + nc1 = map%desc_Y%get_local_cols() + nr2 = map%desc_X%get_global_rows() + nc2 = map%desc_X%get_local_cols() + + call psb_geall(xt,map%p_desc_Y,info) + call psb_geasb(xt,map%p_desc_Y,info,mold=x%v) + call psb_geall(yt,map%p_desc_X,info) + call psb_geasb(yt,map%p_desc_X,info,mold=y%v) + xta = x + call xt%set(xta(1:nr1)) + + if (info == psb_success_) call psb_halo(xt,map%desc_Y,info,work=work) + if (info == psb_success_) call psb_csmm(done,map%map_Y2X,xt,dzero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_X)) then + yta = yt + call psb_sum(ictxt,yta(1:nr2)) + call yt%set(yta) + end if + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_X,info) + if (info /= psb_success_) then + write(psb_err_unit,*) trim(name),' Error from inner routines',info + info = -1 + end if + + call psb_gefree(xt,map%p_desc_Y,info) + call psb_gefree(yt,map%p_desc_Y,info) + + case default + write(psb_err_unit,*) trim(name),' Invalid descriptor input' + info = 1 + return + end select + +end subroutine psb_d_map_Y2X_vect + +function psb_d_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) result(this) + + use psb_base_mod, psb_protect_name => psb_d_linmap + + implicit none + type(psb_dlinmap_type) :: this + type(psb_desc_type), target :: desc_X, desc_Y + type(psb_dspmat_type), intent(in) :: map_X2Y, map_Y2X + integer, intent(in) :: map_kind + integer, intent(in), optional :: iaggr(:), naggr(:) + ! + integer :: info + character(len=20), parameter :: name='psb_linmap' + logical, parameter :: debug=.false. + + info = psb_success_ + select case(map_kind) + case (psb_map_aggr_) + ! OK + + if (psb_is_ok_desc(desc_X)) then + this%p_desc_X=>desc_X + else + info = psb_err_pivot_too_small_ + endif + if (psb_is_ok_desc(desc_Y)) then + this%p_desc_Y=>desc_Y + else + info = psb_err_invalid_ovr_num_ + endif + if (present(iaggr)) then + if (.not.present(naggr)) then + info = 7 + else + allocate(this%iaggr(size(iaggr)),& + & this%naggr(size(naggr)), stat=info) + if (info == psb_success_) then + this%iaggr(:) = iaggr(:) + this%naggr(:) = naggr(:) + end if + end if + else + allocate(this%iaggr(0), this%naggr(0), stat=info) + end if + + case(psb_map_gen_linear_) + + if (psb_is_ok_desc(desc_X)) then + call psb_cdcpy(desc_X, this%desc_X,info) + else + info = psb_err_pivot_too_small_ + endif + if (psb_is_ok_desc(desc_Y)) then + call psb_cdcpy(desc_Y, this%desc_Y,info) + else + info = psb_err_invalid_ovr_num_ + endif + ! For a general linear map ignore iaggr,naggr + allocate(this%iaggr(0), this%naggr(0), stat=info) + + case default + write(psb_err_unit,*) 'Bad map kind into psb_linmap ',map_kind + info = 1 + end select + + if (info == psb_success_) call psb_clone(map_X2Y,this%map_X2Y,info) + if (info == psb_success_) call psb_clone(map_Y2X,this%map_Y2X,info) + if (info == psb_success_) call psb_realloc(psb_itd_data_size_,this%itd_data,info) + if (info == psb_success_) then + call psb_set_map_kind(map_kind, this) + end if + if (info /= psb_success_) then + write(psb_err_unit,*) trim(name),' Invalid descriptor input' + return + end if + if (debug) then +!!$ write(psb_err_unit,*) trim(name),' forward map:',allocated(this%map_X2Y%aspk) +!!$ write(psb_err_unit,*) trim(name),' backward map:',allocated(this%map_Y2X%aspk) + end if + +end function psb_d_linmap diff --git a/base/tools/psb_dallc.f90 b/base/tools/psb_dallc.f90 index ce2a3cae4..e096e9151 100644 --- a/base/tools/psb_dallc.f90 +++ b/base/tools/psb_dallc.f90 @@ -76,7 +76,7 @@ subroutine psb_dalloc(x, desc_a, info, n, lb) endif !... check m and n parameters.... - if (.not.psb_is_ok_desc(desc_a)) then + if (.not.desc_a%is_ok()) then info = psb_err_input_matrix_unassembled_ call psb_errpush(info,name) goto 9999 @@ -253,3 +253,186 @@ subroutine psb_dallocv(x, desc_a,info,n) end subroutine psb_dallocv +subroutine psb_dalloc_vect(x, desc_a,info,n) + use psb_base_mod, psb_protect_name => psb_dalloc_vect + use psi_mod + implicit none + + !....parameters... + type(psb_d_vect_type), intent(out) :: x + type(psb_desc_type), intent(in) :: desc_a + integer,intent(out) :: info + integer, optional, intent(in) :: n + + !locals + integer :: np,me,nr,i,err_act + integer :: ictxt, int_err(5) + integer :: debug_level, debug_unit + character(len=20) :: name + + info=psb_success_ + if (psb_errstatus_fatal()) return + name='psb_geall' + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt=desc_a%get_context() + + call psb_info(ictxt, me, np) + ! ....verify blacs grid correctness.. + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + !... check m and n parameters.... + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if + + ! As this is a rank-1 array, optional parameter N is actually ignored. + + !....allocate x ..... + if (psb_is_asb_desc(desc_a).or.psb_is_upd_desc(desc_a)) then + nr = max(1,desc_a%get_local_cols()) + else if (psb_is_bld_desc(desc_a)) then + nr = max(1,desc_a%get_local_rows()) + else + info = psb_err_internal_error_ + call psb_errpush(info,name,int_err,a_err='Invalid desc_a') + goto 9999 + endif + + allocate(psb_d_base_vect_type :: x%v, stat=info) + if (info == 0) call x%all(nr,info) + if (psb_errstatus_fatal()) then + info=psb_err_alloc_request_ + int_err(1)=nr + call psb_errpush(info,name,int_err,a_err='real(psb_dpk_)') + goto 9999 + endif + call x%zero() + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end subroutine psb_dalloc_vect + +subroutine psb_dalloc_vect_r2(x, desc_a,info,n,lb) + use psb_base_mod, psb_protect_name => psb_dalloc_vect_r2 + use psi_mod + implicit none + + !....parameters... + type(psb_d_vect_type), allocatable, intent(out) :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer,intent(out) :: info + integer, optional, intent(in) :: n,lb + + !locals + integer :: np,me,nr,i,err_act, n_, lb_ + integer :: ictxt, int_err(5), exch(1) + integer :: debug_level, debug_unit + character(len=20) :: name + + info=psb_success_ + if (psb_errstatus_fatal()) return + name='psb_geall' + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt=desc_a%get_context() + + call psb_info(ictxt, me, np) + ! ....verify blacs grid correctness.. + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + !... check m and n parameters.... + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if + + if (present(n)) then + n_ = n + else + n_ = 1 + endif + if (present(lb)) then + lb_ = lb + else + lb_ = 1 + endif + + !global check on n parameters + if (me == psb_root_) then + exch(1)=n_ + call psb_bcast(ictxt,exch(1),root=psb_root_) + else + call psb_bcast(ictxt,exch(1),root=psb_root_) + if (exch(1) /= n_) then + info=psb_err_parm_differs_among_procs_ + int_err(1)=1 + call psb_errpush(info,name,int_err) + goto 9999 + endif + endif + ! As this is a rank-1 array, optional parameter N is actually ignored. + + !....allocate x ..... + if (desc_a%is_asb().or.desc_a%is_upd()) then + nr = max(1,desc_a%get_local_cols()) + else if (desc_a%is_bld()) then + nr = max(1,desc_a%get_local_rows()) + else + info = psb_err_internal_error_ + call psb_errpush(info,name,int_err,a_err='Invalid desc_a') + goto 9999 + endif + + allocate(x(lb_:lb_+n_-1), stat=info) + if (info == 0) then + do i=lb_, lb_+n_-1 + allocate(psb_d_base_vect_type :: x(i)%v, stat=info) + if (info == 0) call x(i)%all(nr,info) + if (info == 0) call x(i)%zero() + if (info /= 0) exit + end do + end if + if (psb_errstatus_fatal()) then + info=psb_err_alloc_request_ + int_err(1)=nr + call psb_errpush(info,name,int_err,a_err='real(psb_dpk_)') + goto 9999 + endif + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end subroutine psb_dalloc_vect_r2 diff --git a/base/tools/psb_dasb.f90 b/base/tools/psb_dasb.f90 index 32e74428c..c32c0f893 100644 --- a/base/tools/psb_dasb.f90 +++ b/base/tools/psb_dasb.f90 @@ -250,3 +250,148 @@ subroutine psb_dasbv(x, desc_a, info) end subroutine psb_dasbv +subroutine psb_dasb_vect(x, desc_a, info, mold) + use psb_base_mod, psb_protect_name => psb_dasb_vect + implicit none + + type(psb_desc_type), intent(in) :: desc_a + type(psb_d_vect_type), intent(inout) :: x + integer, intent(out) :: info + class(psb_d_base_vect_type), intent(in), optional :: mold + + ! local variables + integer :: ictxt,np,me + integer :: int_err(5), i1sz,nrow,ncol, err_act + integer :: debug_level, debug_unit + character(len=20) :: name,ch_err + + info = psb_success_ + if (psb_errstatus_fatal()) return + + int_err(1) = 0 + name = 'psb_dgeasb_v' + + ictxt = desc_a%get_context() + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + call psb_info(ictxt, me, np) + + ! ....verify blacs grid correctness.. + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + else if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if + + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),': sizes: ',nrow,ncol + + call x%asb(ncol,info) + ! ..update halo elements.. + call psb_halo(x,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_halo') + goto 9999 + end if + if (present(mold)) then + call x%cnv(mold) + end if + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),': end' + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end subroutine psb_dasb_vect + + +subroutine psb_dasb_vect_r2(x, desc_a, info, mold) + use psb_base_mod, psb_protect_name => psb_dasb_vect_r2 + implicit none + + type(psb_desc_type), intent(in) :: desc_a + type(psb_d_vect_type), intent(inout) :: x(:) + integer, intent(out) :: info + class(psb_d_base_vect_type), intent(in), optional :: mold + + ! local variables + integer :: ictxt,np,me, i, n + integer :: int_err(5), i1sz,nrow,ncol, err_act + integer :: debug_level, debug_unit + character(len=20) :: name,ch_err + + info = psb_success_ + if (psb_errstatus_fatal()) return + + int_err(1) = 0 + name = 'psb_dgeasb_v' + + ictxt = desc_a%get_context() + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + call psb_info(ictxt, me, np) + + ! ....verify blacs grid correctness.. + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + else if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if + + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + n = size(x) + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),': sizes: ',nrow,ncol + + do i=1, n + call x(i)%asb(ncol,info) + if (info /= 0) exit + ! ..update halo elements.. + call psb_halo(x(i),desc_a,info) + if (info /= 0) exit + if (present(mold)) then + call x(i)%cnv(mold) + end if + end do + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_halo') + goto 9999 + end if + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),': end' + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end subroutine psb_dasb_vect_r2 diff --git a/base/tools/psb_dcdbldext.F90 b/base/tools/psb_dcdbldext.F90 index 31e03fa91..dcbcb3fa1 100644 --- a/base/tools/psb_dcdbldext.F90 +++ b/base/tools/psb_dcdbldext.F90 @@ -74,7 +74,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) ! .. Array Arguments .. integer, intent(in) :: novr - Type(psb_dspmat_type), Intent(in) :: a + Type(psb_dspmat_type), Intent(in) :: a Type(psb_desc_type), Intent(in), target :: desc_a Type(psb_desc_type), Intent(out) :: desc_ov integer, intent(out) :: info @@ -100,10 +100,16 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) name='psb_dcdbldext' info = psb_success_ + if (psb_errstatus_fatal()) return call psb_erractionsave(err_act) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if ictxt = desc_a%get_context() icomm = desc_a%get_mpic() Call psb_info(ictxt, me, np) @@ -143,10 +149,10 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) & ': Calling desccpy' call psb_cdcpy(desc_a,desc_ov,info) - if (info /= psb_success_) then + + if (psb_errstatus_fatal()) then info=psb_err_from_subroutine_ - ch_err='psb_cdcpy' - call psb_errpush(info,name,a_err=ch_err) + call psb_errpush(info,name,a_err='psb_cdcpy') goto 9999 end if @@ -219,15 +225,12 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) Allocate(works(lworks),workr(lworkr),t_halo_in(l_tmp_halo),& & t_halo_out(l_tmp_halo), temp(lworkr),stat=info) - if (info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') - goto 9999 - end if - - Allocate(orig_ovr(l_tmp_ovr_idx),tmp_ovr_idx(l_tmp_ovr_idx),& + if (info == psb_success_) allocate(orig_ovr(l_tmp_ovr_idx),& + & tmp_ovr_idx(l_tmp_ovr_idx), & & tmp_halo(l_tmp_halo), halo(size(desc_a%halo_index)),stat=info) + if (info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') + call psb_errpush(psb_err_alloc_dealloc_,name) goto 9999 end if halo(:) = desc_a%halo_index(:) @@ -257,6 +260,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) goto 9999 endif call psb_ensure_size((cntov_o+3),orig_ovr,info,pad=-1) + if (info /= psb_success_) then info=psb_err_from_subroutine_ call psb_errpush(info,name,a_err='psb_ensure_size') @@ -370,6 +374,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) tmp_ovr_idx(counter_o+3) = -1 counter_o=counter_o+3 call psb_ensure_size((counter_h+3),tmp_halo,info,pad=-1) + if (info /= psb_success_) then info=psb_err_from_subroutine_ call psb_errpush(info,name,a_err='psb_ensure_size') @@ -464,12 +469,13 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) ! matchings SENDs. ! call mpi_alltoall(sdsz,1,mpi_integer,rvsz,1,mpi_integer,icomm,info) + if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='mpi_alltoall' - call psb_errpush(info,name,a_err=ch_err) + call psb_errpush(info,name,a_err='mpi_alltoall') goto 9999 end if + idxs = 0 idxr = 0 counter = 1 @@ -490,10 +496,10 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) iszr=sum(rvsz) if (max(iszr,1) > lworkr) then call psb_realloc(max(iszr,1),workr,info) - if (info /= psb_success_) then - info=psb_err_from_subroutine_ - ch_err='psb_realloc' - call psb_errpush(info,name,a_err=ch_err) + + if (psb_errstatus_fatal()) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) goto 9999 end if lworkr = max(iszr,1) @@ -503,8 +509,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) & workr,rvsz,brvindx,mpi_integer,icomm,info) if (info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='mpi_alltoallv' - call psb_errpush(info,name,a_err=ch_err) + call psb_errpush(info,name,a_err='mpi_alltoallv') goto 9999 end if @@ -512,6 +517,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) & write(debug_unit,*) me,' ',trim(name),': ISZR :',iszr call psb_ensure_size(iszr,maskr,info) + if (info /= psb_success_) then info=psb_err_from_subroutine_ call psb_errpush(info,name,a_err='psb_ensure_size') diff --git a/base/tools/psb_dfree.f90 b/base/tools/psb_dfree.f90 index 3a5098ffd..46407e909 100644 --- a/base/tools/psb_dfree.f90 +++ b/base/tools/psb_dfree.f90 @@ -165,3 +165,116 @@ subroutine psb_dfreev(x, desc_a, info) return end subroutine psb_dfreev + +subroutine psb_dfree_vect(x, desc_a, info) + use psb_base_mod, psb_protect_name => psb_dfree_vect + implicit none + !....parameters... + type(psb_d_vect_type), intent(inout) :: x + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + !...locals.... + integer :: ictxt,np,me,err_act + character(len=20) :: name + + + info=psb_success_ + if (psb_errstatus_fatal()) return + call psb_erractionsave(err_act) + name='psb_dfreev' + + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if + ictxt = desc_a%get_context() + + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + call x%free(info) + + if (info /= psb_no_err_) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + endif + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end subroutine psb_dfree_vect + +subroutine psb_dfree_vect_r2(x, desc_a, info) + use psb_base_mod, psb_protect_name => psb_dfree_vect_r2 + implicit none + !....parameters... + type(psb_d_vect_type), allocatable, intent(inout) :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + !...locals.... + integer :: ictxt,np,me,err_act, i + character(len=20) :: name + + + info=psb_success_ + if (psb_errstatus_fatal()) return + call psb_erractionsave(err_act) + name='psb_dfreev' + + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if + ictxt = desc_a%get_context() + + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + + do i=lbound(x,1),ubound(x,1) + call x(i)%free(info) + if (info /= 0) exit + end do + if (info == 0) deallocate(x,stat=info) + if (info /= psb_no_err_) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + endif + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end subroutine psb_dfree_vect_r2 diff --git a/base/tools/psb_dins.f90 b/base/tools/psb_dins.f90 index bdc9fb404..5e8902551 100644 --- a/base/tools/psb_dins.f90 +++ b/base/tools/psb_dins.f90 @@ -55,13 +55,13 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl) ! must be inserted !....parameters... - integer, intent(in) :: m - integer, intent(in) :: irw(:) + integer, intent(in) :: m + integer, intent(in) :: irw(:) real(psb_dpk_), intent(in) :: val(:) real(psb_dpk_), intent(inout) :: x(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - integer, optional, intent(in) :: dupl + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, optional, intent(in) :: dupl !locals..... integer :: ictxt,i,& @@ -178,6 +178,229 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl) end subroutine psb_dinsvi +subroutine psb_dins_vect(m, irw, val, x, desc_a, info, dupl) + use psb_base_mod, psb_protect_name => psb_dins_vect + use psi_mod + implicit none + + ! m rows number of submatrix belonging to val to be inserted + ! ix x global-row corresponding to position at which val submatrix + ! must be inserted + + !....parameters... + integer, intent(in) :: m + integer, intent(in) :: irw(:) + real(psb_dpk_), intent(in) :: val(:) + type(psb_d_vect_type), intent(inout) :: x + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, optional, intent(in) :: dupl + + !locals..... + integer :: ictxt,i,& + & loc_rows,loc_cols,mglob,err_act, int_err(5) + integer :: np, me, dupl_ + integer, allocatable :: irl(:) + character(len=20) :: name + + if (psb_errstatus_fatal()) return + info=psb_success_ + call psb_erractionsave(err_act) + name = 'psb_dinsvi' + + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if + + ictxt = desc_a%get_context() + + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + !... check parameters.... + if (m < 0) then + info = psb_err_iarg_neg_ + int_err(1) = 1 + int_err(2) = m + call psb_errpush(info,name,int_err) + goto 9999 + else if (x%get_nrows() < desc_a%get_local_rows()) then + info = 310 + int_err(1) = 5 + int_err(2) = 4 + call psb_errpush(info,name,int_err) + goto 9999 + endif + + if (m == 0) return + loc_rows = desc_a%get_local_rows() + loc_cols = desc_a%get_local_cols() + mglob = desc_a%get_global_rows() + + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + + allocate(irl(m),stat=info) + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + endif + + if (present(dupl)) then + dupl_ = dupl + else + dupl_ = psb_dupl_ovwrt_ + endif + + call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + + call x%ins(m,irl,val,dupl_,info) + if (info /= 0) then + call psb_errpush(info,name) + goto 9999 + end if + deallocate(irl) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_ret_) then + return + else + call psb_error(ictxt) + end if + return + +end subroutine psb_dins_vect + +subroutine psb_dins_vect_r2(m, irw, val, x, desc_a, info, dupl) + use psb_base_mod, psb_protect_name => psb_dins_vect_r2 + use psi_mod + implicit none + + ! m rows number of submatrix belonging to val to be inserted + ! ix x global-row corresponding to position at which val submatrix + ! must be inserted + + !....parameters... + integer, intent(in) :: m + integer, intent(in) :: irw(:) + real(psb_dpk_), intent(in) :: val(:,:) + type(psb_d_vect_type), intent(inout) :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, optional, intent(in) :: dupl + + !locals..... + integer :: ictxt,i,& + & loc_rows,loc_cols,mglob,err_act, int_err(5), n + integer :: np, me, dupl_ + integer, allocatable :: irl(:) + character(len=20) :: name + + if (psb_errstatus_fatal()) return + info=psb_success_ + call psb_erractionsave(err_act) + name = 'psb_dinsvi' + + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if + + ictxt = desc_a%get_context() + + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x(1)%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + !... check parameters.... + if (m < 0) then + info = psb_err_iarg_neg_ + int_err(1) = 1 + int_err(2) = m + call psb_errpush(info,name,int_err) + goto 9999 + else if (x(1)%get_nrows() < desc_a%get_local_rows()) then + info = 310 + int_err(1) = 5 + int_err(2) = 4 + call psb_errpush(info,name,int_err) + goto 9999 + endif + + if (m == 0) return + loc_rows = desc_a%get_local_rows() + loc_cols = desc_a%get_local_cols() + mglob = desc_a%get_global_rows() + + + + n = min(size(x),size(val,2)) + allocate(irl(m),stat=info) + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + endif + + if (present(dupl)) then + dupl_ = dupl + else + dupl_ = psb_dupl_ovwrt_ + endif + + call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + do i=1,n + if (.not.allocated(x(i)%v)) info = psb_err_invalid_vect_state_ + if (info == 0) call x(i)%ins(m,irl,val(:,i),dupl_,info) + if (info /= 0) exit + end do + if (info /= 0) then + call psb_errpush(info,name) + goto 9999 + end if + deallocate(irl) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_ret_) then + return + else + call psb_error(ictxt) + end if + return + +end subroutine psb_dins_vect_r2 + !!$ !!$ Parallel Sparse BLAS version 3.0 @@ -239,8 +462,8 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl) !....parameters... integer, intent(in) :: m integer, intent(in) :: irw(:) - real(psb_dpk_), intent(in) :: val(:,:) - real(psb_dpk_), intent(inout) :: x(:,:) + real(psb_dpk_), intent(in) :: val(:,:) + real(psb_dpk_), intent(inout) :: x(:,:) type(psb_desc_type), intent(in) :: desc_a integer, intent(out) :: info integer, optional, intent(in) :: dupl @@ -252,15 +475,16 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl) integer, allocatable :: irl(:) character(len=20) :: name - if(psb_get_errstatus() /= 0) return info=psb_success_ + if (psb_errstatus_fatal()) return call psb_erractionsave(err_act) name = 'psb_dinsi' - if (.not.psb_is_ok_desc(desc_a)) then - int_err(1)=3110 - call psb_errpush(info,name) - return + if (.not.desc_a%is_ok()) then + info = psb_err_input_matrix_unassembled_ + int_err(1) = desc_a%get_dectype() + call psb_errpush(info,name,int_err) + goto 9999 end if ictxt = desc_a%get_context() @@ -279,11 +503,6 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl) int_err(2) = m call psb_errpush(info,name,int_err) goto 9999 - else if (.not.psb_is_ok_desc(desc_a)) then - info = psb_err_input_matrix_unassembled_ - int_err(1) = desc_a%get_dectype() - call psb_errpush(info,name,int_err) - goto 9999 else if (size(x, dim=1) < desc_a%get_local_rows()) then info = 310 int_err(1) = 5 @@ -313,7 +532,7 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl) endif call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) - + select case(dupl_) case(psb_dupl_ovwrt_) do i = 1, m diff --git a/base/tools/psb_dspalloc.f90 b/base/tools/psb_dspalloc.f90 index f18a7db93..4465ec2ab 100644 --- a/base/tools/psb_dspalloc.f90 +++ b/base/tools/psb_dspalloc.f90 @@ -59,13 +59,19 @@ subroutine psb_dspalloc(a, desc_a, info, nnz) integer :: debug_level, debug_unit character(len=20) :: name, ch_err - if(psb_get_errstatus() /= 0) return info=psb_success_ + if (psb_errstatus_fatal()) return call psb_erractionsave(err_act) name = 'psb_dspall' debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if + ictxt = desc_a%get_context() dectype = desc_a%get_dectype() @@ -104,9 +110,8 @@ subroutine psb_dspalloc(a, desc_a, info, nnz) !....allocate aspk, ia1, ia2..... call a%csall(loc_row,loc_col,info,nz=length_ia1) - if(info /= psb_success_) then + if (psb_errstatus_fatal()) then info=psb_err_from_subroutine_ - ch_err='sp_all' call psb_errpush(info,name,int_err) goto 9999 end if diff --git a/base/tools/psb_dspasb.f90 b/base/tools/psb_dspasb.f90 index f23424ddb..246560dac 100644 --- a/base/tools/psb_dspasb.f90 +++ b/base/tools/psb_dspasb.f90 @@ -88,12 +88,12 @@ subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl, mold) goto 9999 endif - if (.not.psb_is_asb_desc(desc_a)) then - info = psb_err_spmat_invalid_state_ - int_err(1) = desc_a%get_dectype() + if (.not.desc_a%is_asb()) then + info = psb_err_invalid_cd_state_ call psb_errpush(info,name) goto 9999 - endif + end if + if (debug_level >= psb_debug_ext_)& & write(debug_unit, *) me,' ',trim(name),& @@ -122,10 +122,9 @@ subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl, mold) & info,' ',ch_err end IF - if (info /= psb_no_err_) then + if (psb_errstatus_fatal()) then info=psb_err_from_subroutine_ - ch_err='psb_spcnv' - call psb_errpush(info,name,a_err=ch_err) + call psb_errpush(info,name,a_err='cscnv') goto 9999 endif diff --git a/base/tools/psb_dspfree.f90 b/base/tools/psb_dspfree.f90 index cd6333a43..eedd61c29 100644 --- a/base/tools/psb_dspfree.f90 +++ b/base/tools/psb_dspfree.f90 @@ -56,16 +56,21 @@ subroutine psb_dspfree(a, desc_a,info) name = 'psb_dspfree' call psb_erractionsave(err_act) - if (.not.psb_is_ok_desc(desc_a)) then - info=psb_err_forgot_spall_ + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ call psb_errpush(info,name) - return + goto 9999 else ictxt = desc_a%get_context() end if !...deallocate a.... call a%free() + if (psb_errstatus_fatal()) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='a%free') + goto 9999 + end if call psb_erractionrestore(err_act) return diff --git a/base/tools/psb_dsphalo.F90 b/base/tools/psb_dsphalo.F90 index e411594cf..52df05df6 100644 --- a/base/tools/psb_dsphalo.F90 +++ b/base/tools/psb_dsphalo.F90 @@ -91,8 +91,8 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,& integer :: debug_level, debug_unit character(len=20) :: name, ch_err - if(psb_get_errstatus() /= 0) return info=psb_success_ + if (psb_errstatus_fatal()) return name='psb_dsphalo' call psb_erractionsave(err_act) debug_unit = psb_get_debug_unit() @@ -133,6 +133,12 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,& outfmt_ = 'CSR' endif + if (.not.desc_a%is_asb()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if + ictxt = desc_a%get_context() icomm = desc_a%get_mpic() diff --git a/base/tools/psb_dspins.f90 b/base/tools/psb_dspins.f90 index d9e7cb041..f034b02a6 100644 --- a/base/tools/psb_dspins.f90 +++ b/base/tools/psb_dspins.f90 @@ -70,19 +70,18 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild) character(len=20) :: name, ch_err info = psb_success_ + if (psb_errstatus_fatal()) return name = 'psb_dspins' call psb_erractionsave(err_act) - - ictxt = desc_a%get_context() - - call psb_info(ictxt, me, np) - - if (.not.psb_is_ok_desc(desc_a)) then - info = psb_err_invalid_cd_state_ + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ call psb_errpush(info,name) goto 9999 - endif + end if + + ictxt = desc_a%get_context() + call psb_info(ictxt, me, np) if (nz < 0) then info = 1111 @@ -215,24 +214,22 @@ subroutine psb_dspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) character(len=20) :: name, ch_err info = psb_success_ + if (psb_errstatus_fatal()) return name = 'psb_dspins' call psb_erractionsave(err_act) - - - ictxt = desc_ar%get_context() - - call psb_info(ictxt, me, np) - - if (.not.psb_is_ok_desc(desc_ar)) then - info = psb_err_invalid_cd_state_ - call psb_errpush(info,name) - goto 9999 - endif - if (.not.psb_is_ok_desc(desc_ac)) then + if (.not.desc_ar%is_ok()) then info = psb_err_invalid_cd_state_ call psb_errpush(info,name) goto 9999 - endif + end if + if (.not.desc_ac%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if + + ictxt = desc_ar%get_context() + call psb_info(ictxt, me, np) if (nz < 0) then info = 1111 @@ -257,7 +254,7 @@ subroutine psb_dspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) end if if (nz == 0) return - if (psb_is_bld_desc(desc_ac)) then + if (desc_ac%is_bld()) then allocate(ila(nz),jla(nz),stat=info) if (info /= psb_success_) then @@ -272,7 +269,7 @@ subroutine psb_dspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) call psb_cdins(nz,ja,desc_ac,info,jla=jla, mask=(ila(1:nz)>0)) - if (info /= psb_success_) then + if (psb_errstatus_fatal()) then ch_err='psb_cdins' call psb_errpush(psb_err_from_subroutine_ai_,name,& & a_err=ch_err,i_err=(/info,0,0,0,0/)) @@ -283,14 +280,14 @@ subroutine psb_dspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) ncol = desc_ac%get_local_cols() call a%csput(nz,ila,jla,val,1,nrow,1,ncol,info) - if (info /= psb_success_) then + if (psb_errstatus_fatal()) then info=psb_err_from_subroutine_ ch_err='psb_coins' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - else if (psb_is_asb_desc(desc_ac)) then + else if (desc_ac%is_asb()) then write(psb_err_unit,*) 'Why are you calling me on an assembled desc_ac?' info = psb_err_invalid_cd_state_ diff --git a/base/tools/psb_dsprn.f90 b/base/tools/psb_dsprn.f90 index 87668b214..98fc9efe4 100644 --- a/base/tools/psb_dsprn.f90 +++ b/base/tools/psb_dsprn.f90 @@ -59,23 +59,29 @@ Subroutine psb_dsprn(a, desc_a,info,clear) logical :: clear_ info = psb_success_ + if (psb_errstatus_fatal()) return err = 0 int_err(1)=0 name = 'psb_dsprn' call psb_erractionsave(err_act) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': start ' - if (psb_is_bld_desc(desc_a)) then + if (a%is_bld()) then ! Should do nothing, we are called redundantly return endif - if (.not.psb_is_asb_desc(desc_a)) then + if (.not.a%is_asb()) then info=590 call psb_errpush(info,name) goto 9999 @@ -83,7 +89,7 @@ Subroutine psb_dsprn(a, desc_a,info,clear) call a%reinit(clear=clear) - if (info /= psb_success_) goto 9999 + if (psb_errstatus_fatal()) goto 9999 if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': done' diff --git a/base/tools/psb_linmap.f90 b/base/tools/psb_linmap.f90 deleted file mode 100644 index 33fcaad11..000000000 --- a/base/tools/psb_linmap.f90 +++ /dev/null @@ -1,345 +0,0 @@ -!!$ -!!$ Parallel Sparse BLAS version 3.0 -!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 -!!$ Salvatore Filippone University of Rome Tor Vergata -!!$ Alfredo Buttari CNRS-IRIT, Toulouse -!!$ -!!$ Redistribution and use in source and binary forms, with or without -!!$ modification, are permitted provided that the following conditions -!!$ are met: -!!$ 1. Redistributions of source code must retain the above copyright -!!$ notice, this list of conditions and the following disclaimer. -!!$ 2. Redistributions in binary form must reproduce the above copyright -!!$ notice, this list of conditions, and the following disclaimer in the -!!$ documentation and/or other materials provided with the distribution. -!!$ 3. The name of the PSBLAS group or the names of its contributors may -!!$ not be used to endorse or promote products derived from this -!!$ software without specific written permission. -!!$ -!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS -!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -!!$ POSSIBILITY OF SUCH DAMAGE. -!!$ -!!$ - -function psb_c_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) result(this) - - use psb_base_mod, psb_protect_name => psb_c_linmap - - implicit none - type(psb_clinmap_type) :: this - type(psb_desc_type), target :: desc_X, desc_Y - type(psb_cspmat_type), intent(in) :: map_X2Y, map_Y2X - integer, intent(in) :: map_kind - integer, intent(in), optional :: iaggr(:), naggr(:) - ! - integer :: info - character(len=20), parameter :: name='psb_linmap' - - info = psb_success_ - select case(map_kind) - case (psb_map_aggr_) - ! OK - if (psb_is_ok_desc(desc_X)) then - this%p_desc_X=>desc_X - else - info = psb_err_pivot_too_small_ - endif - if (psb_is_ok_desc(desc_Y)) then - this%p_desc_Y=>desc_Y - else - info = psb_err_invalid_ovr_num_ - endif - if (present(iaggr)) then - if (.not.present(naggr)) then - info = 7 - else - allocate(this%iaggr(size(iaggr)),& - & this%naggr(size(naggr)), stat=info) - if (info == psb_success_) then - this%iaggr(:) = iaggr(:) - this%naggr(:) = naggr(:) - end if - end if - else - allocate(this%iaggr(0), this%naggr(0), stat=info) - end if - - case(psb_map_gen_linear_) - - if (psb_is_ok_desc(desc_X)) then - call psb_cdcpy(desc_X, this%desc_X,info) - else - info = psb_err_pivot_too_small_ - endif - if (psb_is_ok_desc(desc_Y)) then - call psb_cdcpy(desc_Y, this%desc_Y,info) - else - info = psb_err_invalid_ovr_num_ - endif - ! For a general linear map ignore iaggr,naggr - allocate(this%iaggr(0), this%naggr(0), stat=info) - - case default - write(psb_err_unit,*) 'Bad map kind into psb_linmap ',map_kind - info = 1 - end select - - if (info == psb_success_) call psb_clone(map_X2Y,this%map_X2Y,info) - if (info == psb_success_) call psb_clone(map_Y2X,this%map_Y2X,info) - if (info == psb_success_) call psb_realloc(psb_itd_data_size_,this%itd_data,info) - if (info == psb_success_) then - call psb_set_map_kind(map_kind, this) - end if - if (info /= psb_success_) then - write(psb_err_unit,*) trim(name),' Invalid descriptor input' - return - end if - -end function psb_c_linmap - -function psb_d_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) result(this) - - use psb_base_mod, psb_protect_name => psb_d_linmap - - implicit none - type(psb_dlinmap_type) :: this - type(psb_desc_type), target :: desc_X, desc_Y - type(psb_dspmat_type), intent(in) :: map_X2Y, map_Y2X - integer, intent(in) :: map_kind - integer, intent(in), optional :: iaggr(:), naggr(:) - ! - integer :: info - character(len=20), parameter :: name='psb_linmap' - logical, parameter :: debug=.false. - - info = psb_success_ - select case(map_kind) - case (psb_map_aggr_) - ! OK - - if (psb_is_ok_desc(desc_X)) then - this%p_desc_X=>desc_X - else - info = psb_err_pivot_too_small_ - endif - if (psb_is_ok_desc(desc_Y)) then - this%p_desc_Y=>desc_Y - else - info = psb_err_invalid_ovr_num_ - endif - if (present(iaggr)) then - if (.not.present(naggr)) then - info = 7 - else - allocate(this%iaggr(size(iaggr)),& - & this%naggr(size(naggr)), stat=info) - if (info == psb_success_) then - this%iaggr(:) = iaggr(:) - this%naggr(:) = naggr(:) - end if - end if - else - allocate(this%iaggr(0), this%naggr(0), stat=info) - end if - - case(psb_map_gen_linear_) - - if (psb_is_ok_desc(desc_X)) then - call psb_cdcpy(desc_X, this%desc_X,info) - else - info = psb_err_pivot_too_small_ - endif - if (psb_is_ok_desc(desc_Y)) then - call psb_cdcpy(desc_Y, this%desc_Y,info) - else - info = psb_err_invalid_ovr_num_ - endif - ! For a general linear map ignore iaggr,naggr - allocate(this%iaggr(0), this%naggr(0), stat=info) - - case default - write(psb_err_unit,*) 'Bad map kind into psb_linmap ',map_kind - info = 1 - end select - - if (info == psb_success_) call psb_clone(map_X2Y,this%map_X2Y,info) - if (info == psb_success_) call psb_clone(map_Y2X,this%map_Y2X,info) - if (info == psb_success_) call psb_realloc(psb_itd_data_size_,this%itd_data,info) - if (info == psb_success_) then - call psb_set_map_kind(map_kind, this) - end if - if (info /= psb_success_) then - write(psb_err_unit,*) trim(name),' Invalid descriptor input' - return - end if - if (debug) then -!!$ write(psb_err_unit,*) trim(name),' forward map:',allocated(this%map_X2Y%aspk) -!!$ write(psb_err_unit,*) trim(name),' backward map:',allocated(this%map_Y2X%aspk) - end if - -end function psb_d_linmap - -function psb_s_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) result(this) - - use psb_base_mod, psb_protect_name => psb_s_linmap - - implicit none - type(psb_slinmap_type) :: this - type(psb_desc_type), target :: desc_X, desc_Y - type(psb_sspmat_type), intent(in) :: map_X2Y, map_Y2X - integer, intent(in) :: map_kind - integer, intent(in), optional :: iaggr(:), naggr(:) - ! - integer :: info - character(len=20), parameter :: name='psb_linmap' - - info = psb_success_ - - select case(map_kind) - case (psb_map_aggr_) - ! OK - - if (psb_is_ok_desc(desc_X)) then - this%p_desc_X=>desc_X - else - info = psb_err_pivot_too_small_ - endif - if (psb_is_ok_desc(desc_Y)) then - this%p_desc_Y=>desc_Y - else - info = psb_err_invalid_ovr_num_ - endif - if (present(iaggr)) then - if (.not.present(naggr)) then - info = 7 - else - allocate(this%iaggr(size(iaggr)),& - & this%naggr(size(naggr)), stat=info) - if (info == psb_success_) then - this%iaggr(:) = iaggr(:) - this%naggr(:) = naggr(:) - end if - end if - else - allocate(this%iaggr(0), this%naggr(0), stat=info) - end if - - case(psb_map_gen_linear_) - - if (psb_is_ok_desc(desc_X)) then - call psb_cdcpy(desc_X, this%desc_X,info) - else - info = psb_err_pivot_too_small_ - endif - if (psb_is_ok_desc(desc_Y)) then - call psb_cdcpy(desc_Y, this%desc_Y,info) - else - info = psb_err_invalid_ovr_num_ - endif - ! For a general linear map ignore iaggr,naggr - allocate(this%iaggr(0), this%naggr(0), stat=info) - - case default - write(psb_err_unit,*) 'Bad map kind into psb_linmap ',map_kind - info = 1 - end select - - - if (info == psb_success_) call psb_clone(map_X2Y,this%map_X2Y,info) - if (info == psb_success_) call psb_clone(map_Y2X,this%map_Y2X,info) - if (info == psb_success_) call psb_realloc(psb_itd_data_size_,this%itd_data,info) - if (info == psb_success_) then - call psb_set_map_kind(map_kind, this) - end if - if (info /= psb_success_) then - write(psb_err_unit,*) trim(name),' Invalid descriptor input' - return - end if - -end function psb_s_linmap - -function psb_z_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) result(this) - - use psb_base_mod, psb_protect_name => psb_z_linmap - - implicit none - type(psb_zlinmap_type) :: this - type(psb_desc_type), target :: desc_X, desc_Y - type(psb_zspmat_type), intent(in) :: map_X2Y, map_Y2X - integer, intent(in) :: map_kind - integer, intent(in), optional :: iaggr(:), naggr(:) - ! - integer :: info - character(len=20), parameter :: name='psb_linmap' - - info = psb_success_ - select case(map_kind) - case (psb_map_aggr_) - ! OK - - if (psb_is_ok_desc(desc_X)) then - this%p_desc_X=>desc_X - else - info = psb_err_pivot_too_small_ - endif - if (psb_is_ok_desc(desc_Y)) then - this%p_desc_Y=>desc_Y - else - info = psb_err_invalid_ovr_num_ - endif - if (present(iaggr)) then - if (.not.present(naggr)) then - info = 7 - else - allocate(this%iaggr(size(iaggr)),& - & this%naggr(size(naggr)), stat=info) - if (info == psb_success_) then - this%iaggr(:) = iaggr(:) - this%naggr(:) = naggr(:) - end if - end if - else - allocate(this%iaggr(0), this%naggr(0), stat=info) - end if - - case(psb_map_gen_linear_) - - if (psb_is_ok_desc(desc_X)) then - call psb_cdcpy(desc_X, this%desc_X,info) - else - info = psb_err_pivot_too_small_ - endif - if (psb_is_ok_desc(desc_Y)) then - call psb_cdcpy(desc_Y, this%desc_Y,info) - else - info = psb_err_invalid_ovr_num_ - endif - ! For a general linear map ignore iaggr,naggr - allocate(this%iaggr(0), this%naggr(0), stat=info) - - case default - write(psb_err_unit,*) 'Bad map kind into psb_linmap ',map_kind - info = 1 - end select - - if (info == psb_success_) call psb_clone(map_X2Y,this%map_X2Y,info) - if (info == psb_success_) call psb_clone(map_Y2X,this%map_Y2X,info) - if (info == psb_success_) call psb_realloc(psb_itd_data_size_,this%itd_data,info) - if (info == psb_success_) then - call psb_set_map_kind(map_kind, this) - end if - if (info /= psb_success_) then - write(psb_err_unit,*) trim(name),' Invalid descriptor input' - return - end if - -end function psb_z_linmap diff --git a/base/tools/psb_map.f90 b/base/tools/psb_map.f90 deleted file mode 100644 index ca2767196..000000000 --- a/base/tools/psb_map.f90 +++ /dev/null @@ -1,660 +0,0 @@ -!!$ -!!$ Parallel Sparse BLAS version 3.0 -!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 -!!$ Salvatore Filippone University of Rome Tor Vergata -!!$ Alfredo Buttari CNRS-IRIT, Toulouse -!!$ -!!$ Redistribution and use in source and binary forms, with or without -!!$ modification, are permitted provided that the following conditions -!!$ are met: -!!$ 1. Redistributions of source code must retain the above copyright -!!$ notice, this list of conditions and the following disclaimer. -!!$ 2. Redistributions in binary form must reproduce the above copyright -!!$ notice, this list of conditions, and the following disclaimer in the -!!$ documentation and/or other materials provided with the distribution. -!!$ 3. The name of the PSBLAS group or the names of its contributors may -!!$ not be used to endorse or promote products derived from this -!!$ software without specific written permission. -!!$ -!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS -!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -!!$ POSSIBILITY OF SUCH DAMAGE. -!!$ -!!$ -!!$ -! -! -subroutine psb_s_map_X2Y(alpha,x,beta,y,map,info,work) - use psb_base_mod, psb_protect_name => psb_s_map_X2Y - implicit none - type(psb_slinmap_type), intent(in) :: map - real(psb_spk_), intent(in) :: alpha,beta - real(psb_spk_), intent(inout) :: x(:) - real(psb_spk_), intent(out) :: y(:) - integer, intent(out) :: info - real(psb_spk_), optional :: work(:) - - ! - real(psb_spk_), allocatable :: xt(:), yt(:) - integer :: i, j, nr1, nc1,nr2, nc2,& - & map_kind, map_data, nr, ictxt - character(len=20), parameter :: name='psb_map_X2Y' - - info = psb_success_ - if (.not.psb_is_asb_map(map)) then - write(psb_err_unit,*) trim(name),' Invalid descriptor input' - info = 1 - return - end if - - map_kind = psb_get_map_kind(map) - - select case(map_kind) - case(psb_map_aggr_) - - ictxt = map%p_desc_Y%get_context() - nr2 = map%p_desc_Y%get_global_rows() - nc2 = map%p_desc_Y%get_local_cols() - allocate(yt(nc2),stat=info) - if (info == psb_success_) call psb_halo(x,map%p_desc_X,info,work=work) - if (info == psb_success_) call psb_csmm(sone,map%map_X2Y,x,szero,yt,info) - if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_Y)) then - call psb_sum(ictxt,yt(1:nr2)) - end if - if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_Y,info) - if (info /= psb_success_) then - write(psb_err_unit,*) trim(name),' Error from inner routines',info - info = -1 - end if - - case(psb_map_gen_linear_) - - ictxt = map%desc_Y%get_context() - nr1 = map%desc_X%get_local_rows() - nc1 = map%desc_X%get_local_cols() - nr2 = map%desc_Y%get_global_rows() - nc2 = map%desc_Y%get_local_cols() - allocate(xt(nc1),yt(nc2),stat=info) - xt(1:nr1) = x(1:nr1) - if (info == psb_success_) call psb_halo(xt,map%desc_X,info,work=work) - if (info == psb_success_) call psb_csmm(sone,map%map_X2Y,xt,szero,yt,info) - if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_Y)) then - call psb_sum(ictxt,yt(1:nr2)) - end if - if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_Y,info) - if (info /= psb_success_) then - write(psb_err_unit,*) trim(name),' Error from inner routines',info - info = -1 - end if - - - case default - write(psb_err_unit,*) trim(name),' Invalid descriptor input' - info = 1 - return - end select - -end subroutine psb_s_map_X2Y - - -! -! Takes a vector x from space map%p_desc_Y and maps it onto -! map%p_desc_X under map%map_Y2X possibly with communication -! due to exch_bk_idx -! -subroutine psb_s_map_Y2X(alpha,x,beta,y,map,info,work) - use psb_base_mod, psb_protect_name => psb_s_map_Y2X - - implicit none - type(psb_slinmap_type), intent(in) :: map - real(psb_spk_), intent(in) :: alpha,beta - real(psb_spk_), intent(inout) :: x(:) - real(psb_spk_), intent(out) :: y(:) - integer, intent(out) :: info - real(psb_spk_), optional :: work(:) - - ! - real(psb_spk_), allocatable :: xt(:), yt(:) - integer :: i, j, nr1, nc1,nr2, nc2,& - & map_kind, map_data, nr, ictxt - character(len=20), parameter :: name='psb_map_Y2X' - - info = psb_success_ - if (.not.psb_is_asb_map(map)) then - write(psb_err_unit,*) trim(name),' Invalid descriptor input' - info = 1 - return - end if - - map_kind = psb_get_map_kind(map) - - select case(map_kind) - case(psb_map_aggr_) - - ictxt = map%p_desc_X%get_context() - nr2 = map%p_desc_X%get_global_rows() - nc2 = map%p_desc_X%get_local_cols() - allocate(yt(nc2),stat=info) - if (info == psb_success_) call psb_halo(x,map%p_desc_Y,info,work=work) - if (info == psb_success_) call psb_csmm(sone,map%map_Y2X,x,szero,yt,info) - if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_X)) then - call psb_sum(ictxt,yt(1:nr2)) - end if - if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_X,info) - if (info /= psb_success_) then - write(psb_err_unit,*) trim(name),' Error from inner routines',info - info = -1 - end if - - case(psb_map_gen_linear_) - - ictxt = map%desc_X%get_context() - nr1 = map%desc_Y%get_local_rows() - nc1 = map%desc_Y%get_local_cols() - nr2 = map%desc_X%get_global_rows() - nc2 = map%desc_X%get_local_cols() - allocate(xt(nc1),yt(nc2),stat=info) - xt(1:nr1) = x(1:nr1) - if (info == psb_success_) call psb_halo(xt,map%desc_Y,info,work=work) - if (info == psb_success_) call psb_csmm(sone,map%map_Y2X,xt,szero,yt,info) - if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_X)) then - call psb_sum(ictxt,yt(1:nr2)) - end if - if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_X,info) - if (info /= psb_success_) then - write(psb_err_unit,*) trim(name),' Error from inner routines',info - info = -1 - end if - - - case default - write(psb_err_unit,*) trim(name),' Invalid descriptor input' - info = 1 - return - end select - -end subroutine psb_s_map_Y2X - - -! -! Takes a vector x from space map%p_desc_X and maps it onto -! map%p_desc_Y under map%map_X2Y possibly with communication -! due to exch_fw_idx -! -subroutine psb_d_map_X2Y(alpha,x,beta,y,map,info,work) - use psb_base_mod, psb_protect_name => psb_d_map_X2Y - implicit none - type(psb_dlinmap_type), intent(in) :: map - real(psb_dpk_), intent(in) :: alpha,beta - real(psb_dpk_), intent(inout) :: x(:) - real(psb_dpk_), intent(out) :: y(:) - integer, intent(out) :: info - real(psb_dpk_), optional :: work(:) - - ! - real(psb_dpk_), allocatable :: xt(:), yt(:) - integer :: i, j, nr1, nc1,nr2, nc2 ,& - & map_kind, map_data, nr, ictxt - character(len=20), parameter :: name='psb_map_X2Y' - - info = psb_success_ - if (.not.psb_is_asb_map(map)) then - write(psb_err_unit,*) trim(name),' Invalid descriptor input: unassembled' - info = 1 - return - end if - - map_kind = psb_get_map_kind(map) - - select case(map_kind) - case(psb_map_aggr_) - - ictxt = map%p_desc_Y%get_context() - nr2 = map%p_desc_Y%get_global_rows() - nc2 = map%p_desc_Y%get_local_cols() - allocate(yt(nc2),stat=info) - if (info == psb_success_) call psb_halo(x,map%p_desc_X,info,work=work) - if (info == psb_success_) call psb_csmm(done,map%map_X2Y,x,dzero,yt,info) - if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_Y)) then - call psb_sum(ictxt,yt(1:nr2)) - end if - if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_Y,info) - if (info /= psb_success_) then - write(psb_err_unit,*) trim(name),' Error from inner routines',info - info = -1 - end if - - case(psb_map_gen_linear_) - - ictxt = map%desc_Y%get_context() - nr1 = map%desc_X%get_local_rows() - nc1 = map%desc_X%get_local_cols() - nr2 = map%desc_Y%get_global_rows() - nc2 = map%desc_Y%get_local_cols() - allocate(xt(nc1),yt(nc2),stat=info) - xt(1:nr1) = x(1:nr1) - if (info == psb_success_) call psb_halo(xt,map%desc_X,info,work=work) - if (info == psb_success_) call psb_csmm(done,map%map_X2Y,xt,dzero,yt,info) - if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_Y)) then - call psb_sum(ictxt,yt(1:nr2)) - end if - if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_Y,info) - if (info /= psb_success_) then - write(psb_err_unit,*) trim(name),' Error from inner routines',info - info = -1 - end if - - - case default - write(psb_err_unit,*) trim(name),' Invalid descriptor input', & - & map_kind, psb_map_aggr_, psb_map_gen_linear_ - info = 1 - return - end select - -end subroutine psb_d_map_X2Y - - -! -! Takes a vector x from space map%p_desc_Y and maps it onto -! map%p_desc_X under map%map_Y2X possibly with communication -! due to exch_bk_idx -! -subroutine psb_d_map_Y2X(alpha,x,beta,y,map,info,work) - use psb_base_mod, psb_protect_name => psb_d_map_Y2X - - implicit none - type(psb_dlinmap_type), intent(in) :: map - real(psb_dpk_), intent(in) :: alpha,beta - real(psb_dpk_), intent(inout) :: x(:) - real(psb_dpk_), intent(out) :: y(:) - integer, intent(out) :: info - real(psb_dpk_), optional :: work(:) - - ! - real(psb_dpk_), allocatable :: xt(:), yt(:) - integer :: i, j, nr1, nc1,nr2, nc2,& - & map_kind, map_data, nr, ictxt - character(len=20), parameter :: name='psb_map_Y2X' - - info = psb_success_ - if (.not.psb_is_asb_map(map)) then - write(psb_err_unit,*) trim(name),' Invalid descriptor input' - info = 1 - return - end if - - map_kind = psb_get_map_kind(map) - - select case(map_kind) - case(psb_map_aggr_) - - ictxt = map%p_desc_X%get_context() - nr2 = map%p_desc_X%get_global_rows() - nc2 = map%p_desc_X%get_local_cols() - allocate(yt(nc2),stat=info) - if (info == psb_success_) call psb_halo(x,map%p_desc_Y,info,work=work) - if (info == psb_success_) call psb_csmm(done,map%map_Y2X,x,dzero,yt,info) - if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_X)) then - call psb_sum(ictxt,yt(1:nr2)) - end if - if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_X,info) - if (info /= psb_success_) then - write(psb_err_unit,*) trim(name),' Error from inner routines',info - info = -1 - end if - - case(psb_map_gen_linear_) - - ictxt = map%desc_X%get_context() - nr1 = map%desc_Y%get_local_rows() - nc1 = map%desc_Y%get_local_cols() - nr2 = map%desc_X%get_global_rows() - nc2 = map%desc_X%get_local_cols() - allocate(xt(nc1),yt(nc2),stat=info) - xt(1:nr1) = x(1:nr1) - if (info == psb_success_) call psb_halo(xt,map%desc_Y,info,work=work) - if (info == psb_success_) call psb_csmm(done,map%map_Y2X,xt,dzero,yt,info) - if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_X)) then - call psb_sum(ictxt,yt(1:nr2)) - end if - if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_X,info) - if (info /= psb_success_) then - write(psb_err_unit,*) trim(name),' Error from inner routines',info - info = -1 - end if - - - case default - write(psb_err_unit,*) trim(name),' Invalid descriptor input' - info = 1 - return - end select - -end subroutine psb_d_map_Y2X - - -! -! Takes a vector x from space map%p_desc_X and maps it onto -! map%p_desc_Y under map%map_X2Y possibly with communication -! due to exch_fw_idx -! -subroutine psb_c_map_X2Y(alpha,x,beta,y,map,info,work) - use psb_base_mod, psb_protect_name => psb_c_map_X2Y - - implicit none - type(psb_clinmap_type), intent(in) :: map - complex(psb_spk_), intent(in) :: alpha,beta - complex(psb_spk_), intent(inout) :: x(:) - complex(psb_spk_), intent(out) :: y(:) - integer, intent(out) :: info - complex(psb_spk_), optional :: work(:) - - ! - complex(psb_spk_), allocatable :: xt(:), yt(:) - integer :: i, j, nr1, nc1,nr2, nc2,& - & map_kind, map_data, nr, ictxt - character(len=20), parameter :: name='psb_map_X2Y' - - info = psb_success_ - if (.not.psb_is_asb_map(map)) then - write(psb_err_unit,*) trim(name),' Invalid descriptor input' - info = 1 - return - end if - - map_kind = psb_get_map_kind(map) - - select case(map_kind) - case(psb_map_aggr_) - - ictxt = map%p_desc_Y%get_context() - nr2 = map%p_desc_Y%get_global_rows() - nc2 = map%p_desc_Y%get_local_cols() - allocate(yt(nc2),stat=info) - if (info == psb_success_) call psb_halo(x,map%p_desc_X,info,work=work) - if (info == psb_success_) call psb_csmm(cone,map%map_X2Y,x,czero,yt,info) - if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_Y)) then - call psb_sum(ictxt,yt(1:nr2)) - end if - if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_Y,info) - if (info /= psb_success_) then - write(psb_err_unit,*) trim(name),' Error from inner routines',info - info = -1 - end if - - case(psb_map_gen_linear_) - - ictxt = map%desc_Y%get_context() - nr1 = map%desc_X%get_local_rows() - nc1 = map%desc_X%get_local_cols() - nr2 = map%desc_Y%get_global_rows() - nc2 = map%desc_Y%get_local_cols() - allocate(xt(nc1),yt(nc2),stat=info) - xt(1:nr1) = x(1:nr1) - if (info == psb_success_) call psb_halo(xt,map%desc_X,info,work=work) - if (info == psb_success_) call psb_csmm(cone,map%map_X2Y,xt,czero,yt,info) - if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_Y)) then - call psb_sum(ictxt,yt(1:nr2)) - end if - if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_Y,info) - if (info /= psb_success_) then - write(psb_err_unit,*) trim(name),' Error from inner routines',info - info = -1 - end if - - - case default - write(psb_err_unit,*) trim(name),' Invalid descriptor input' - info = 1 - return - end select - -end subroutine psb_c_map_X2Y - - -! -! Takes a vector x from space map%p_desc_Y and maps it onto -! map%p_desc_X under map%map_Y2X possibly with communication -! due to exch_bk_idx -! -subroutine psb_c_map_Y2X(alpha,x,beta,y,map,info,work) - use psb_base_mod, psb_protect_name => psb_c_map_Y2X - - implicit none - type(psb_clinmap_type), intent(in) :: map - complex(psb_spk_), intent(in) :: alpha,beta - complex(psb_spk_), intent(inout) :: x(:) - complex(psb_spk_), intent(out) :: y(:) - integer, intent(out) :: info - complex(psb_spk_), optional :: work(:) - - ! - complex(psb_spk_), allocatable :: xt(:), yt(:) - integer :: i, j, nr1, nc1,nr2, nc2,& - & map_kind, map_data, nr, ictxt - character(len=20), parameter :: name='psb_map_Y2X' - - info = psb_success_ - if (.not.psb_is_asb_map(map)) then - write(psb_err_unit,*) trim(name),' Invalid descriptor input' - info = 1 - return - end if - - map_kind = psb_get_map_kind(map) - - select case(map_kind) - case(psb_map_aggr_) - - ictxt = map%p_desc_X%get_context() - nr2 = map%p_desc_X%get_global_rows() - nc2 = map%p_desc_X%get_local_cols() - allocate(yt(nc2),stat=info) - if (info == psb_success_) call psb_halo(x,map%p_desc_Y,info,work=work) - if (info == psb_success_) call psb_csmm(cone,map%map_Y2X,x,czero,yt,info) - if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_X)) then - call psb_sum(ictxt,yt(1:nr2)) - end if - if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_X,info) - if (info /= psb_success_) then - write(psb_err_unit,*) trim(name),' Error from inner routines',info - info = -1 - end if - - case(psb_map_gen_linear_) - - ictxt = map%desc_X%get_context() - nr1 = map%desc_Y%get_local_rows() - nc1 = map%desc_Y%get_local_cols() - nr2 = map%desc_X%get_global_rows() - nc2 = map%desc_X%get_local_cols() - allocate(xt(nc1),yt(nc2),stat=info) - xt(1:nr1) = x(1:nr1) - if (info == psb_success_) call psb_halo(xt,map%desc_Y,info,work=work) - if (info == psb_success_) call psb_csmm(cone,map%map_Y2X,xt,czero,yt,info) - if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_X)) then - call psb_sum(ictxt,yt(1:nr2)) - end if - if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_X,info) - if (info /= psb_success_) then - write(psb_err_unit,*) trim(name),' Error from inner routines',info - info = -1 - end if - - - case default - write(psb_err_unit,*) trim(name),' Invalid descriptor input' - info = 1 - return - end select - -end subroutine psb_c_map_Y2X - - -! -! Takes a vector x from space map%p_desc_X and maps it onto -! map%p_desc_Y under map%map_X2Y possibly with communication -! due to exch_fw_idx -! -subroutine psb_z_map_X2Y(alpha,x,beta,y,map,info,work) - use psb_base_mod, psb_protect_name => psb_z_map_X2Y - - implicit none - type(psb_zlinmap_type), intent(in) :: map - complex(psb_dpk_), intent(in) :: alpha,beta - complex(psb_dpk_), intent(inout) :: x(:) - complex(psb_dpk_), intent(out) :: y(:) - integer, intent(out) :: info - complex(psb_dpk_), optional :: work(:) - - ! - complex(psb_dpk_), allocatable :: xt(:), yt(:) - integer :: i, j, nr1, nc1,nr2, nc2,& - & map_kind, map_data, nr, ictxt - character(len=20), parameter :: name='psb_map_X2Y' - - info = psb_success_ - if (.not.psb_is_asb_map(map)) then - write(psb_err_unit,*) trim(name),' Invalid descriptor input' - info = 1 - return - end if - - map_kind = psb_get_map_kind(map) - - select case(map_kind) - case(psb_map_aggr_) - - ictxt = map%p_desc_Y%get_context() - nr2 = map%p_desc_Y%get_global_rows() - nc2 = map%p_desc_Y%get_local_cols() - allocate(yt(nc2),stat=info) - if (info == psb_success_) call psb_halo(x,map%p_desc_X,info,work=work) - if (info == psb_success_) call psb_csmm(zone,map%map_X2Y,x,zzero,yt,info) - if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_Y)) then - call psb_sum(ictxt,yt(1:nr2)) - end if - if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_Y,info) - if (info /= psb_success_) then - write(psb_err_unit,*) trim(name),' Error from inner routines',info - info = -1 - end if - - case(psb_map_gen_linear_) - - ictxt = map%desc_Y%get_context() - nr1 = map%desc_X%get_local_rows() - nc1 = map%desc_X%get_local_cols() - nr2 = map%desc_Y%get_global_rows() - nc2 = map%desc_Y%get_local_cols() - allocate(xt(nc1),yt(nc2),stat=info) - xt(1:nr1) = x(1:nr1) - if (info == psb_success_) call psb_halo(xt,map%desc_X,info,work=work) - if (info == psb_success_) call psb_csmm(zone,map%map_X2Y,xt,zzero,yt,info) - if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_Y)) then - call psb_sum(ictxt,yt(1:nr2)) - end if - if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_Y,info) - if (info /= psb_success_) then - write(psb_err_unit,*) trim(name),' Error from inner routines',info - info = -1 - end if - - - case default - write(psb_err_unit,*) trim(name),' Invalid descriptor input' - info = 1 - return - end select - -end subroutine psb_z_map_X2Y - - -! -! Takes a vector x from space map%p_desc_Y and maps it onto -! map%p_desc_X under map%map_Y2X possibly with communication -! due to exch_bk_idx -! -subroutine psb_z_map_Y2X(alpha,x,beta,y,map,info,work) - use psb_base_mod, psb_protect_name => psb_z_map_Y2X - - implicit none - type(psb_zlinmap_type), intent(in) :: map - complex(psb_dpk_), intent(in) :: alpha,beta - complex(psb_dpk_), intent(inout) :: x(:) - complex(psb_dpk_), intent(out) :: y(:) - integer, intent(out) :: info - complex(psb_dpk_), optional :: work(:) - - ! - complex(psb_dpk_), allocatable :: xt(:), yt(:) - integer :: i, j, nr1, nc1,nr2, nc2,& - & map_kind, map_data, nr, ictxt - character(len=20), parameter :: name='psb_map_Y2X' - - info = psb_success_ - if (.not.psb_is_asb_map(map)) then - write(psb_err_unit,*) trim(name),' Invalid descriptor input' - info = 1 - return - end if - - map_kind = psb_get_map_kind(map) - - select case(map_kind) - case(psb_map_aggr_) - - ictxt = map%p_desc_X%get_context() - nr2 = map%p_desc_X%get_global_rows() - nc2 = map%p_desc_X%get_local_cols() - allocate(yt(nc2),stat=info) - if (info == psb_success_) call psb_halo(x,map%p_desc_Y,info,work=work) - if (info == psb_success_) call psb_csmm(zone,map%map_Y2X,x,zzero,yt,info) - if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_X)) then - call psb_sum(ictxt,yt(1:nr2)) - end if - if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_X,info) - if (info /= psb_success_) then - write(psb_err_unit,*) trim(name),' Error from inner routines',info - info = -1 - end if - - case(psb_map_gen_linear_) - - ictxt = map%desc_X%get_context() - nr1 = map%desc_Y%get_local_rows() - nc1 = map%desc_Y%get_local_cols() - nr2 = map%desc_X%get_global_rows() - nc2 = map%desc_X%get_local_cols() - allocate(xt(nc1),yt(nc2),stat=info) - xt(1:nr1) = x(1:nr1) - if (info == psb_success_) call psb_halo(xt,map%desc_Y,info,work=work) - if (info == psb_success_) call psb_csmm(zone,map%map_Y2X,xt,zzero,yt,info) - if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_X)) then - call psb_sum(ictxt,yt(1:nr2)) - end if - if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_X,info) - if (info /= psb_success_) then - write(psb_err_unit,*) trim(name),' Error from inner routines',info - info = -1 - end if - - - case default - write(psb_err_unit,*) trim(name),' Invalid descriptor input' - info = 1 - return - end select - -end subroutine psb_z_map_Y2X - - diff --git a/base/tools/psb_s_map.f90 b/base/tools/psb_s_map.f90 new file mode 100644 index 000000000..8631ebd10 --- /dev/null +++ b/base/tools/psb_s_map.f90 @@ -0,0 +1,443 @@ +!!$ +!!$ Parallel Sparse BLAS version 3.0 +!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +!!$ +! +! +! +! Takes a vector x from space map%p_desc_X and maps it onto +! map%p_desc_Y under map%map_X2Y possibly with communication +! due to exch_fw_idx +! +subroutine psb_s_map_X2Y(alpha,x,beta,y,map,info,work) + use psb_base_mod, psb_protect_name => psb_s_map_X2Y + implicit none + type(psb_slinmap_type), intent(in) :: map + real(psb_spk_), intent(in) :: alpha,beta + real(psb_spk_), intent(inout) :: x(:) + real(psb_spk_), intent(out) :: y(:) + integer, intent(out) :: info + real(psb_spk_), optional :: work(:) + + ! + real(psb_spk_), allocatable :: xt(:), yt(:) + integer :: i, j, nr1, nc1,nr2, nc2,& + & map_kind, map_data, nr, ictxt + character(len=20), parameter :: name='psb_map_X2Y' + + info = psb_success_ + if (.not.psb_is_asb_map(map)) then + write(psb_err_unit,*) trim(name),' Invalid descriptor input: unassembled' + info = 1 + return + end if + + map_kind = psb_get_map_kind(map) + + select case(map_kind) + case(psb_map_aggr_) + + ictxt = map%p_desc_Y%get_context() + nr2 = map%p_desc_Y%get_global_rows() + nc2 = map%p_desc_Y%get_local_cols() + allocate(yt(nc2),stat=info) + if (info == psb_success_) call psb_halo(x,map%p_desc_X,info,work=work) + if (info == psb_success_) call psb_csmm(sone,map%map_X2Y,x,szero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_Y)) then + call psb_sum(ictxt,yt(1:nr2)) + end if + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_Y,info) + if (info /= psb_success_) then + write(psb_err_unit,*) trim(name),' Error from inner routines',info + info = -1 + end if + + case(psb_map_gen_linear_) + + ictxt = map%desc_Y%get_context() + nr1 = map%desc_X%get_local_rows() + nc1 = map%desc_X%get_local_cols() + nr2 = map%desc_Y%get_global_rows() + nc2 = map%desc_Y%get_local_cols() + allocate(xt(nc1),yt(nc2),stat=info) + xt(1:nr1) = x(1:nr1) + if (info == psb_success_) call psb_halo(xt,map%desc_X,info,work=work) + if (info == psb_success_) call psb_csmm(sone,map%map_X2Y,xt,szero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_Y)) then + call psb_sum(ictxt,yt(1:nr2)) + end if + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_Y,info) + if (info /= psb_success_) then + write(psb_err_unit,*) trim(name),' Error from inner routines',info + info = -1 + end if + + + case default + write(psb_err_unit,*) trim(name),' Invalid descriptor input', & + & map_kind, psb_map_aggr_, psb_map_gen_linear_ + info = 1 + return + end select + +end subroutine psb_s_map_X2Y + + +subroutine psb_s_map_X2Y_vect(alpha,x,beta,y,map,info,work) + use psb_base_mod, psb_protect_name => psb_s_map_X2Y_vect + implicit none + type(psb_slinmap_type), intent(in) :: map + real(psb_spk_), intent(in) :: alpha,beta + type(psb_s_vect_type), intent(inout) :: x,y + integer, intent(out) :: info + real(psb_spk_), optional :: work(:) + ! Local + type(psb_s_vect_type) :: xt, yt + real(psb_spk_), allocatable :: xta(:), yta(:) + integer :: i, j, nr1, nc1,nr2, nc2 ,& + & map_kind, map_data, nr, ictxt + character(len=20), parameter :: name='psb_map_X2Y' + + info = psb_success_ + if (.not.psb_is_asb_map(map)) then + write(psb_err_unit,*) trim(name),' Invalid descriptor input: unassembled' + info = 1 + return + end if + + map_kind = psb_get_map_kind(map) + + select case(map_kind) + case(psb_map_aggr_) + + ictxt = map%p_desc_Y%get_context() + nr2 = map%p_desc_Y%get_global_rows() + nc2 = map%p_desc_Y%get_local_cols() + call psb_geall(yt,map%p_desc_Y,info) + call psb_geasb(yt,map%p_desc_Y,info,mold=y%v) + if (info == psb_success_) call psb_halo(x,map%p_desc_X,info,work=work) + if (info == psb_success_) call psb_csmm(sone,map%map_X2Y,x,szero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_Y)) then + yta = yt + call psb_sum(ictxt,yta(1:nr2)) + call yt%set(yta) + end if + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_Y,info) + if (info /= psb_success_) then + write(psb_err_unit,*) trim(name),' Error from inner routines',info + info = -1 + end if + call psb_gefree(yt,map%p_desc_Y,info) + + case(psb_map_gen_linear_) + + ictxt = map%desc_Y%get_context() + nr1 = map%desc_X%get_local_rows() + nc1 = map%desc_X%get_local_cols() + nr2 = map%desc_Y%get_global_rows() + nc2 = map%desc_Y%get_local_cols() + + call psb_geall(xt,map%p_desc_X,info) + call psb_geasb(xt,map%p_desc_X,info,mold=x%v) + call psb_geall(yt,map%p_desc_Y,info) + call psb_geasb(yt,map%p_desc_Y,info,mold=y%v) + xta = x + call xt%set(xta(1:nr1)) + if (info == psb_success_) call psb_halo(xt,map%desc_X,info,work=work) + if (info == psb_success_) call psb_csmm(sone,map%map_X2Y,xt,szero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_Y)) then + yta = yt + call psb_sum(ictxt,yta(1:nr2)) + call yt%set(yta) + end if + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_Y,info) + if (info /= psb_success_) then + write(psb_err_unit,*) trim(name),' Error from inner routines',info + info = -1 + end if + + call psb_gefree(xt,map%p_desc_Y,info) + call psb_gefree(yt,map%p_desc_Y,info) + + case default + write(psb_err_unit,*) trim(name),' Invalid descriptor input', & + & map_kind, psb_map_aggr_, psb_map_gen_linear_ + info = 1 + return + end select + + return +end subroutine psb_s_map_X2Y_vect + + +! +! Takes a vector x from space map%p_desc_Y and maps it onto +! map%p_desc_X under map%map_Y2X possibly with communication +! due to exch_bk_idx +! +subroutine psb_s_map_Y2X(alpha,x,beta,y,map,info,work) + use psb_base_mod, psb_protect_name => psb_s_map_Y2X + + implicit none + type(psb_slinmap_type), intent(in) :: map + real(psb_spk_), intent(in) :: alpha,beta + real(psb_spk_), intent(inout) :: x(:) + real(psb_spk_), intent(out) :: y(:) + integer, intent(out) :: info + real(psb_spk_), optional :: work(:) + + ! + real(psb_spk_), allocatable :: xt(:), yt(:) + integer :: i, j, nr1, nc1,nr2, nc2,& + & map_kind, map_data, nr, ictxt + character(len=20), parameter :: name='psb_map_Y2X' + + info = psb_success_ + if (.not.psb_is_asb_map(map)) then + write(psb_err_unit,*) trim(name),' Invalid descriptor input' + info = 1 + return + end if + + map_kind = psb_get_map_kind(map) + + select case(map_kind) + case(psb_map_aggr_) + + ictxt = map%p_desc_X%get_context() + nr2 = map%p_desc_X%get_global_rows() + nc2 = map%p_desc_X%get_local_cols() + allocate(yt(nc2),stat=info) + if (info == psb_success_) call psb_halo(x,map%p_desc_Y,info,work=work) + if (info == psb_success_) call psb_csmm(sone,map%map_Y2X,x,szero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_X)) then + call psb_sum(ictxt,yt(1:nr2)) + end if + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_X,info) + if (info /= psb_success_) then + write(psb_err_unit,*) trim(name),' Error from inner routines',info + info = -1 + end if + + case(psb_map_gen_linear_) + + ictxt = map%desc_X%get_context() + nr1 = map%desc_Y%get_local_rows() + nc1 = map%desc_Y%get_local_cols() + nr2 = map%desc_X%get_global_rows() + nc2 = map%desc_X%get_local_cols() + allocate(xt(nc1),yt(nc2),stat=info) + xt(1:nr1) = x(1:nr1) + if (info == psb_success_) call psb_halo(xt,map%desc_Y,info,work=work) + if (info == psb_success_) call psb_csmm(sone,map%map_Y2X,xt,szero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_X)) then + call psb_sum(ictxt,yt(1:nr2)) + end if + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_X,info) + if (info /= psb_success_) then + write(psb_err_unit,*) trim(name),' Error from inner routines',info + info = -1 + end if + + + case default + write(psb_err_unit,*) trim(name),' Invalid descriptor input' + info = 1 + return + end select + +end subroutine psb_s_map_Y2X + +subroutine psb_s_map_Y2X_vect(alpha,x,beta,y,map,info,work) + use psb_base_mod, psb_protect_name => psb_s_map_Y2X_vect + implicit none + type(psb_slinmap_type), intent(in) :: map + real(psb_spk_), intent(in) :: alpha,beta + type(psb_s_vect_type), intent(inout) :: x,y + integer, intent(out) :: info + real(psb_spk_), optional :: work(:) + ! + type(psb_s_vect_type) :: xt, yt + real(psb_spk_), allocatable :: xta(:), yta(:) + integer :: i, j, nr1, nc1,nr2, nc2,& + & map_kind, map_data, nr, ictxt + character(len=20), parameter :: name='psb_map_Y2X' + + info = psb_success_ + if (.not.psb_is_asb_map(map)) then + write(psb_err_unit,*) trim(name),' Invalid descriptor input' + info = 1 + return + end if + + map_kind = psb_get_map_kind(map) + + select case(map_kind) + case(psb_map_aggr_) + + ictxt = map%p_desc_X%get_context() + nr2 = map%p_desc_X%get_global_rows() + nc2 = map%p_desc_X%get_local_cols() + call psb_geall(yt,map%p_desc_X,info) + call psb_geasb(yt,map%p_desc_X,info,mold=y%v) + if (info == psb_success_) call psb_halo(x,map%p_desc_Y,info,work=work) + if (info == psb_success_) call psb_csmm(sone,map%map_Y2X,x,szero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_X)) then + yta = yt + call psb_sum(ictxt,yta(1:nr2)) + call yt%set(yta) + end if + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_X,info) + if (info /= psb_success_) then + write(psb_err_unit,*) trim(name),' Error from inner routines',info + info = -1 + end if + call psb_gefree(yt,map%p_desc_Y,info) + + case(psb_map_gen_linear_) + + ictxt = map%desc_X%get_context() + nr1 = map%desc_Y%get_local_rows() + nc1 = map%desc_Y%get_local_cols() + nr2 = map%desc_X%get_global_rows() + nc2 = map%desc_X%get_local_cols() + + call psb_geall(xt,map%p_desc_Y,info) + call psb_geasb(xt,map%p_desc_Y,info,mold=x%v) + call psb_geall(yt,map%p_desc_X,info) + call psb_geasb(yt,map%p_desc_X,info,mold=y%v) + + xta = x + call xt%set(xta(1:nr1)) + + if (info == psb_success_) call psb_halo(xt,map%desc_Y,info,work=work) + if (info == psb_success_) call psb_csmm(sone,map%map_Y2X,xt,szero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_X)) then + yta = yt + call psb_sum(ictxt,yta(1:nr2)) + call yt%set(yta) + end if + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_X,info) + if (info /= psb_success_) then + write(psb_err_unit,*) trim(name),' Error from inner routines',info + info = -1 + end if + + call psb_gefree(xt,map%p_desc_Y,info) + call psb_gefree(yt,map%p_desc_Y,info) + + case default + write(psb_err_unit,*) trim(name),' Invalid descriptor input' + info = 1 + return + end select + +end subroutine psb_s_map_Y2X_vect + +function psb_s_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) result(this) + + use psb_base_mod, psb_protect_name => psb_s_linmap + + implicit none + type(psb_slinmap_type) :: this + type(psb_desc_type), target :: desc_X, desc_Y + type(psb_sspmat_type), intent(in) :: map_X2Y, map_Y2X + integer, intent(in) :: map_kind + integer, intent(in), optional :: iaggr(:), naggr(:) + ! + integer :: info + character(len=20), parameter :: name='psb_linmap' + + info = psb_success_ + + select case(map_kind) + case (psb_map_aggr_) + ! OK + + if (psb_is_ok_desc(desc_X)) then + this%p_desc_X=>desc_X + else + info = psb_err_pivot_too_small_ + endif + if (psb_is_ok_desc(desc_Y)) then + this%p_desc_Y=>desc_Y + else + info = psb_err_invalid_ovr_num_ + endif + if (present(iaggr)) then + if (.not.present(naggr)) then + info = 7 + else + allocate(this%iaggr(size(iaggr)),& + & this%naggr(size(naggr)), stat=info) + if (info == psb_success_) then + this%iaggr(:) = iaggr(:) + this%naggr(:) = naggr(:) + end if + end if + else + allocate(this%iaggr(0), this%naggr(0), stat=info) + end if + + case(psb_map_gen_linear_) + + if (psb_is_ok_desc(desc_X)) then + call psb_cdcpy(desc_X, this%desc_X,info) + else + info = psb_err_pivot_too_small_ + endif + if (psb_is_ok_desc(desc_Y)) then + call psb_cdcpy(desc_Y, this%desc_Y,info) + else + info = psb_err_invalid_ovr_num_ + endif + ! For a general linear map ignore iaggr,naggr + allocate(this%iaggr(0), this%naggr(0), stat=info) + + case default + write(psb_err_unit,*) 'Bad map kind into psb_linmap ',map_kind + info = 1 + end select + + + if (info == psb_success_) call psb_clone(map_X2Y,this%map_X2Y,info) + if (info == psb_success_) call psb_clone(map_Y2X,this%map_Y2X,info) + if (info == psb_success_) call psb_realloc(psb_itd_data_size_,this%itd_data,info) + if (info == psb_success_) then + call psb_set_map_kind(map_kind, this) + end if + if (info /= psb_success_) then + write(psb_err_unit,*) trim(name),' Invalid descriptor input' + return + end if + +end function psb_s_linmap + diff --git a/base/tools/psb_sallc.f90 b/base/tools/psb_sallc.f90 index d6a2ac706..b71475008 100644 --- a/base/tools/psb_sallc.f90 +++ b/base/tools/psb_sallc.f90 @@ -120,7 +120,7 @@ subroutine psb_salloc(x, desc_a, info, n, lb) goto 9999 endif - x(:,:) = dzero + x(:,:) = szero call psb_erractionrestore(err_act) return @@ -238,7 +238,7 @@ subroutine psb_sallocv(x, desc_a,info,n) goto 9999 endif - x(:) = dzero + x(:) = szero call psb_erractionrestore(err_act) return @@ -253,3 +253,186 @@ subroutine psb_sallocv(x, desc_a,info,n) end subroutine psb_sallocv +subroutine psb_salloc_vect(x, desc_a,info,n) + use psb_base_mod, psb_protect_name => psb_salloc_vect + use psi_mod + implicit none + + !....parameters... + type(psb_s_vect_type), intent(out) :: x + type(psb_desc_type), intent(in) :: desc_a + integer,intent(out) :: info + integer, optional, intent(in) :: n + + !locals + integer :: np,me,nr,i,err_act + integer :: ictxt, int_err(5) + integer :: debug_level, debug_unit + character(len=20) :: name + + info=psb_success_ + if (psb_errstatus_fatal()) return + name='psb_geall' + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt=desc_a%get_context() + + call psb_info(ictxt, me, np) + ! ....verify blacs grid correctness.. + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + !... check m and n parameters.... + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if + + ! As this is a rank-1 array, optional parameter N is actually ignored. + + !....allocate x ..... + if (psb_is_asb_desc(desc_a).or.psb_is_upd_desc(desc_a)) then + nr = max(1,desc_a%get_local_cols()) + else if (psb_is_bld_desc(desc_a)) then + nr = max(1,desc_a%get_local_rows()) + else + info = psb_err_internal_error_ + call psb_errpush(info,name,int_err,a_err='Invalid desc_a') + goto 9999 + endif + + allocate(psb_s_base_vect_type :: x%v, stat=info) + if (info == 0) call x%all(nr,info) + if (psb_errstatus_fatal()) then + info=psb_err_alloc_request_ + int_err(1)=nr + call psb_errpush(info,name,int_err,a_err='real(psb_spk_)') + goto 9999 + endif + call x%zero() + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end subroutine psb_salloc_vect + +subroutine psb_salloc_vect_r2(x, desc_a,info,n,lb) + use psb_base_mod, psb_protect_name => psb_salloc_vect_r2 + use psi_mod + implicit none + + !....parameters... + type(psb_s_vect_type), allocatable, intent(out) :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer,intent(out) :: info + integer, optional, intent(in) :: n,lb + + !locals + integer :: np,me,nr,i,err_act, n_, lb_ + integer :: ictxt, int_err(5), exch(1) + integer :: debug_level, debug_unit + character(len=20) :: name + + info=psb_success_ + if (psb_errstatus_fatal()) return + name='psb_geall' + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt=desc_a%get_context() + + call psb_info(ictxt, me, np) + ! ....verify blacs grid correctness.. + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + !... check m and n parameters.... + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if + + if (present(n)) then + n_ = n + else + n_ = 1 + endif + if (present(lb)) then + lb_ = lb + else + lb_ = 1 + endif + + !global check on n parameters + if (me == psb_root_) then + exch(1)=n_ + call psb_bcast(ictxt,exch(1),root=psb_root_) + else + call psb_bcast(ictxt,exch(1),root=psb_root_) + if (exch(1) /= n_) then + info=psb_err_parm_differs_among_procs_ + int_err(1)=1 + call psb_errpush(info,name,int_err) + goto 9999 + endif + endif + ! As this is a rank-1 array, optional parameter N is actually ignored. + + !....allocate x ..... + if (desc_a%is_asb().or.desc_a%is_upd()) then + nr = max(1,desc_a%get_local_cols()) + else if (desc_a%is_bld()) then + nr = max(1,desc_a%get_local_rows()) + else + info = psb_err_internal_error_ + call psb_errpush(info,name,int_err,a_err='Invalid desc_a') + goto 9999 + endif + + allocate(x(lb_:lb_+n_-1), stat=info) + if (info == 0) then + do i=lb_, lb_+n_-1 + allocate(psb_s_base_vect_type :: x(i)%v, stat=info) + if (info == 0) call x(i)%all(nr,info) + if (info == 0) call x(i)%zero() + if (info /= 0) exit + end do + end if + if (psb_errstatus_fatal()) then + info=psb_err_alloc_request_ + int_err(1)=nr + call psb_errpush(info,name,int_err,a_err='real(psb_spk_)') + goto 9999 + endif + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end subroutine psb_salloc_vect_r2 diff --git a/base/tools/psb_sasb.f90 b/base/tools/psb_sasb.f90 index e7ea6ffe3..b192747c8 100644 --- a/base/tools/psb_sasb.f90 +++ b/base/tools/psb_sasb.f90 @@ -250,3 +250,148 @@ subroutine psb_sasbv(x, desc_a, info) end subroutine psb_sasbv +subroutine psb_sasb_vect(x, desc_a, info, mold) + use psb_base_mod, psb_protect_name => psb_sasb_vect + implicit none + + type(psb_desc_type), intent(in) :: desc_a + type(psb_s_vect_type), intent(inout) :: x + integer, intent(out) :: info + class(psb_s_base_vect_type), intent(in), optional :: mold + + ! local variables + integer :: ictxt,np,me + integer :: int_err(5), i1sz,nrow,ncol, err_act + integer :: debug_level, debug_unit + character(len=20) :: name,ch_err + + info = psb_success_ + if (psb_errstatus_fatal()) return + + int_err(1) = 0 + name = 'psb_sgeasb_v' + + ictxt = desc_a%get_context() + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + call psb_info(ictxt, me, np) + + ! ....verify blacs grid correctness.. + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + else if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if + + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),': sizes: ',nrow,ncol + + call x%asb(ncol,info) + ! ..update halo elements.. + call psb_halo(x,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_halo') + goto 9999 + end if + if (present(mold)) then + call x%cnv(mold) + end if + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),': end' + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end subroutine psb_sasb_vect + + +subroutine psb_sasb_vect_r2(x, desc_a, info, mold) + use psb_base_mod, psb_protect_name => psb_sasb_vect_r2 + implicit none + + type(psb_desc_type), intent(in) :: desc_a + type(psb_s_vect_type), intent(inout) :: x(:) + integer, intent(out) :: info + class(psb_s_base_vect_type), intent(in), optional :: mold + + ! local variables + integer :: ictxt,np,me, i, n + integer :: int_err(5), i1sz,nrow,ncol, err_act + integer :: debug_level, debug_unit + character(len=20) :: name,ch_err + + info = psb_success_ + if (psb_errstatus_fatal()) return + + int_err(1) = 0 + name = 'psb_sgeasb_v' + + ictxt = desc_a%get_context() + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + call psb_info(ictxt, me, np) + + ! ....verify blacs grid correctness.. + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + else if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if + + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + n = size(x) + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),': sizes: ',nrow,ncol + + do i=1, n + call x(i)%asb(ncol,info) + if (info /= 0) exit + ! ..update halo elements.. + call psb_halo(x(i),desc_a,info) + if (info /= 0) exit + if (present(mold)) then + call x(i)%cnv(mold) + end if + end do + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_halo') + goto 9999 + end if + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),': end' + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end subroutine psb_sasb_vect_r2 diff --git a/base/tools/psb_sfree.f90 b/base/tools/psb_sfree.f90 index 3c26a40fa..72b634448 100644 --- a/base/tools/psb_sfree.f90 +++ b/base/tools/psb_sfree.f90 @@ -165,3 +165,116 @@ subroutine psb_sfreev(x, desc_a, info) return end subroutine psb_sfreev + +subroutine psb_sfree_vect(x, desc_a, info) + use psb_base_mod, psb_protect_name => psb_sfree_vect + implicit none + !....parameters... + type(psb_s_vect_type), intent(inout) :: x + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + !...locals.... + integer :: ictxt,np,me,err_act + character(len=20) :: name + + + info=psb_success_ + if (psb_errstatus_fatal()) return + call psb_erractionsave(err_act) + name='psb_sfreev' + + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if + ictxt = desc_a%get_context() + + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + call x%free(info) + + if (info /= psb_no_err_) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + endif + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end subroutine psb_sfree_vect + +subroutine psb_sfree_vect_r2(x, desc_a, info) + use psb_base_mod, psb_protect_name => psb_sfree_vect_r2 + implicit none + !....parameters... + type(psb_s_vect_type), allocatable, intent(inout) :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + !...locals.... + integer :: ictxt,np,me,err_act, i + character(len=20) :: name + + + info=psb_success_ + if (psb_errstatus_fatal()) return + call psb_erractionsave(err_act) + name='psb_sfreev' + + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if + ictxt = desc_a%get_context() + + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + + do i=lbound(x,1),ubound(x,1) + call x(i)%free(info) + if (info /= 0) exit + end do + if (info == 0) deallocate(x,stat=info) + if (info /= psb_no_err_) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + endif + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end subroutine psb_sfree_vect_r2 diff --git a/base/tools/psb_sins.f90 b/base/tools/psb_sins.f90 index ef08e8b61..3ab532a25 100644 --- a/base/tools/psb_sins.f90 +++ b/base/tools/psb_sins.f90 @@ -55,13 +55,13 @@ subroutine psb_sinsvi(m, irw, val, x, desc_a, info, dupl) ! must be inserted !....parameters... - integer, intent(in) :: m - integer, intent(in) :: irw(:) + integer, intent(in) :: m + integer, intent(in) :: irw(:) real(psb_spk_), intent(in) :: val(:) real(psb_spk_), intent(inout) :: x(:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - integer, optional, intent(in) :: dupl + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, optional, intent(in) :: dupl !locals..... integer :: ictxt,i,& @@ -178,6 +178,229 @@ subroutine psb_sinsvi(m, irw, val, x, desc_a, info, dupl) end subroutine psb_sinsvi +subroutine psb_sins_vect(m, irw, val, x, desc_a, info, dupl) + use psb_base_mod, psb_protect_name => psb_sins_vect + use psi_mod + implicit none + + ! m rows number of submatrix belonging to val to be inserted + ! ix x global-row corresponding to position at which val submatrix + ! must be inserted + + !....parameters... + integer, intent(in) :: m + integer, intent(in) :: irw(:) + real(psb_spk_), intent(in) :: val(:) + type(psb_s_vect_type), intent(inout) :: x + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, optional, intent(in) :: dupl + + !locals..... + integer :: ictxt,i,& + & loc_rows,loc_cols,mglob,err_act, int_err(5) + integer :: np, me, dupl_ + integer, allocatable :: irl(:) + character(len=20) :: name + + if (psb_errstatus_fatal()) return + info=psb_success_ + call psb_erractionsave(err_act) + name = 'psb_sinsvi' + + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if + + ictxt = desc_a%get_context() + + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + !... check parameters.... + if (m < 0) then + info = psb_err_iarg_neg_ + int_err(1) = 1 + int_err(2) = m + call psb_errpush(info,name,int_err) + goto 9999 + else if (x%get_nrows() < desc_a%get_local_rows()) then + info = 310 + int_err(1) = 5 + int_err(2) = 4 + call psb_errpush(info,name,int_err) + goto 9999 + endif + + if (m == 0) return + loc_rows = desc_a%get_local_rows() + loc_cols = desc_a%get_local_cols() + mglob = desc_a%get_global_rows() + + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + + allocate(irl(m),stat=info) + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + endif + + if (present(dupl)) then + dupl_ = dupl + else + dupl_ = psb_dupl_ovwrt_ + endif + + call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + + call x%ins(m,irl,val,dupl_,info) + if (info /= 0) then + call psb_errpush(info,name) + goto 9999 + end if + deallocate(irl) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_ret_) then + return + else + call psb_error(ictxt) + end if + return + +end subroutine psb_sins_vect + +subroutine psb_sins_vect_r2(m, irw, val, x, desc_a, info, dupl) + use psb_base_mod, psb_protect_name => psb_sins_vect_r2 + use psi_mod + implicit none + + ! m rows number of submatrix belonging to val to be inserted + ! ix x global-row corresponding to position at which val submatrix + ! must be inserted + + !....parameters... + integer, intent(in) :: m + integer, intent(in) :: irw(:) + real(psb_spk_), intent(in) :: val(:,:) + type(psb_s_vect_type), intent(inout) :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, optional, intent(in) :: dupl + + !locals..... + integer :: ictxt,i,& + & loc_rows,loc_cols,mglob,err_act, int_err(5), n + integer :: np, me, dupl_ + integer, allocatable :: irl(:) + character(len=20) :: name + + if (psb_errstatus_fatal()) return + info=psb_success_ + call psb_erractionsave(err_act) + name = 'psb_sinsvi' + + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if + + ictxt = desc_a%get_context() + + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x(1)%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + !... check parameters.... + if (m < 0) then + info = psb_err_iarg_neg_ + int_err(1) = 1 + int_err(2) = m + call psb_errpush(info,name,int_err) + goto 9999 + else if (x(1)%get_nrows() < desc_a%get_local_rows()) then + info = 310 + int_err(1) = 5 + int_err(2) = 4 + call psb_errpush(info,name,int_err) + goto 9999 + endif + + if (m == 0) return + loc_rows = desc_a%get_local_rows() + loc_cols = desc_a%get_local_cols() + mglob = desc_a%get_global_rows() + + + + n = min(size(x),size(val,2)) + allocate(irl(m),stat=info) + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + endif + + if (present(dupl)) then + dupl_ = dupl + else + dupl_ = psb_dupl_ovwrt_ + endif + + call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + do i=1,n + if (.not.allocated(x(i)%v)) info = psb_err_invalid_vect_state_ + if (info == 0) call x(i)%ins(m,irl,val(:,i),dupl_,info) + if (info /= 0) exit + end do + if (info /= 0) then + call psb_errpush(info,name) + goto 9999 + end if + deallocate(irl) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_ret_) then + return + else + call psb_error(ictxt) + end if + return + +end subroutine psb_sins_vect_r2 + !!$ !!$ Parallel Sparse BLAS version 3.0 @@ -210,7 +433,7 @@ end subroutine psb_sinsvi !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -! Subroutine: psb_sinsi +! Subroutine: psb_dinsi ! Insert dense submatrix to dense matrix. Note: the row indices in IRW ! are assumed to be in global numbering and are converted on the fly. ! Row indices not belonging to the current process are silently discarded. @@ -237,13 +460,13 @@ subroutine psb_sinsi(m, irw, val, x, desc_a, info, dupl) ! must be inserted !....parameters... - integer, intent(in) :: m - integer, intent(in) :: irw(:) - real(psb_spk_), intent(in) :: val(:,:) - real(psb_spk_), intent(inout) :: x(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - integer, optional, intent(in) :: dupl + integer, intent(in) :: m + integer, intent(in) :: irw(:) + real(psb_spk_), intent(in) :: val(:,:) + real(psb_spk_), intent(inout) :: x(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, optional, intent(in) :: dupl !locals..... integer :: ictxt,i,loc_row,j,n,& @@ -257,10 +480,11 @@ subroutine psb_sinsi(m, irw, val, x, desc_a, info, dupl) call psb_erractionsave(err_act) name = 'psb_sinsi' - if (.not.psb_is_ok_desc(desc_a)) then - int_err(1)=3110 - call psb_errpush(info,name) - return + if (.not.desc_a%is_ok()) then + info = psb_err_input_matrix_unassembled_ + int_err(1) = desc_a%get_dectype() + call psb_errpush(info,name,int_err) + goto 9999 end if ictxt = desc_a%get_context() @@ -279,11 +503,6 @@ subroutine psb_sinsi(m, irw, val, x, desc_a, info, dupl) int_err(2) = m call psb_errpush(info,name,int_err) goto 9999 - else if (.not.psb_is_ok_desc(desc_a)) then - info = psb_err_input_matrix_unassembled_ - int_err(1) = desc_a%get_dectype() - call psb_errpush(info,name,int_err) - goto 9999 else if (size(x, dim=1) < desc_a%get_local_rows()) then info = 310 int_err(1) = 5 diff --git a/base/tools/psb_z_map.f90 b/base/tools/psb_z_map.f90 new file mode 100644 index 000000000..b5ca51587 --- /dev/null +++ b/base/tools/psb_z_map.f90 @@ -0,0 +1,439 @@ +!!$ +!!$ Parallel Sparse BLAS version 3.0 +!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +!!$ +! +! +! +! Takes a vector x from space map%p_desc_X and maps it onto +! map%p_desc_Y under map%map_X2Y possibly with communication +! due to exch_fw_idx +! +subroutine psb_z_map_X2Y(alpha,x,beta,y,map,info,work) + use psb_base_mod, psb_protect_name => psb_z_map_X2Y + + implicit none + type(psb_zlinmap_type), intent(in) :: map + complex(psb_dpk_), intent(in) :: alpha,beta + complex(psb_dpk_), intent(inout) :: x(:) + complex(psb_dpk_), intent(out) :: y(:) + integer, intent(out) :: info + complex(psb_dpk_), optional :: work(:) + + ! + complex(psb_dpk_), allocatable :: xt(:), yt(:) + integer :: i, j, nr1, nc1,nr2, nc2,& + & map_kind, map_data, nr, ictxt + character(len=20), parameter :: name='psb_map_X2Y' + + info = psb_success_ + if (.not.psb_is_asb_map(map)) then + write(psb_err_unit,*) trim(name),' Invalid descriptor input' + info = 1 + return + end if + + map_kind = psb_get_map_kind(map) + + select case(map_kind) + case(psb_map_aggr_) + + ictxt = map%p_desc_Y%get_context() + nr2 = map%p_desc_Y%get_global_rows() + nc2 = map%p_desc_Y%get_local_cols() + allocate(yt(nc2),stat=info) + if (info == psb_success_) call psb_halo(x,map%p_desc_X,info,work=work) + if (info == psb_success_) call psb_csmm(zone,map%map_X2Y,x,zzero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_Y)) then + call psb_sum(ictxt,yt(1:nr2)) + end if + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_Y,info) + if (info /= psb_success_) then + write(psb_err_unit,*) trim(name),' Error from inner routines',info + info = -1 + end if + + case(psb_map_gen_linear_) + + ictxt = map%desc_Y%get_context() + nr1 = map%desc_X%get_local_rows() + nc1 = map%desc_X%get_local_cols() + nr2 = map%desc_Y%get_global_rows() + nc2 = map%desc_Y%get_local_cols() + allocate(xt(nc1),yt(nc2),stat=info) + xt(1:nr1) = x(1:nr1) + if (info == psb_success_) call psb_halo(xt,map%desc_X,info,work=work) + if (info == psb_success_) call psb_csmm(zone,map%map_X2Y,xt,zzero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_Y)) then + call psb_sum(ictxt,yt(1:nr2)) + end if + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_Y,info) + if (info /= psb_success_) then + write(psb_err_unit,*) trim(name),' Error from inner routines',info + info = -1 + end if + + + case default + write(psb_err_unit,*) trim(name),' Invalid descriptor input' + info = 1 + return + end select + +end subroutine psb_z_map_X2Y + +subroutine psb_z_map_X2Y_vect(alpha,x,beta,y,map,info,work) + use psb_base_mod, psb_protect_name => psb_z_map_X2Y_vect + implicit none + type(psb_zlinmap_type), intent(in) :: map + complex(psb_dpk_), intent(in) :: alpha,beta + type(psb_z_vect_type), intent(inout) :: x,y + integer, intent(out) :: info + complex(psb_dpk_), optional :: work(:) + ! Local + type(psb_z_vect_type) :: xt, yt + complex(psb_dpk_), allocatable :: xta(:), yta(:) + integer :: i, j, nr1, nc1,nr2, nc2 ,& + & map_kind, map_data, nr, ictxt + character(len=20), parameter :: name='psb_map_X2Y' + + info = psb_success_ + if (.not.psb_is_asb_map(map)) then + write(psb_err_unit,*) trim(name),' Invalid descriptor input: unassembled' + info = 1 + return + end if + + map_kind = psb_get_map_kind(map) + + select case(map_kind) + case(psb_map_aggr_) + + ictxt = map%p_desc_Y%get_context() + nr2 = map%p_desc_Y%get_global_rows() + nc2 = map%p_desc_Y%get_local_cols() + call psb_geall(yt,map%p_desc_Y,info) + call psb_geasb(yt,map%p_desc_Y,info,mold=y%v) + if (info == psb_success_) call psb_halo(x,map%p_desc_X,info,work=work) + if (info == psb_success_) call psb_csmm(zone,map%map_X2Y,x,zzero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_Y)) then + yta = yt + call psb_sum(ictxt,yta(1:nr2)) + call yt%set(yta) + end if + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_Y,info) + if (info /= psb_success_) then + write(psb_err_unit,*) trim(name),' Error from inner routines',info + info = -1 + end if + call psb_gefree(yt,map%p_desc_Y,info) + + case(psb_map_gen_linear_) + + ictxt = map%desc_Y%get_context() + nr1 = map%desc_X%get_local_rows() + nc1 = map%desc_X%get_local_cols() + nr2 = map%desc_Y%get_global_rows() + nc2 = map%desc_Y%get_local_cols() + + call psb_geall(xt,map%p_desc_X,info) + call psb_geasb(xt,map%p_desc_X,info,mold=x%v) + call psb_geall(yt,map%p_desc_Y,info) + call psb_geasb(yt,map%p_desc_Y,info,mold=y%v) + xta = x + call xt%set(xta(1:nr1)) + if (info == psb_success_) call psb_halo(xt,map%desc_X,info,work=work) + if (info == psb_success_) call psb_csmm(zone,map%map_X2Y,xt,zzero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_Y)) then + yta = yt + call psb_sum(ictxt,yta(1:nr2)) + call yt%set(yta) + end if + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_Y,info) + if (info /= psb_success_) then + write(psb_err_unit,*) trim(name),' Error from inner routines',info + info = -1 + end if + + call psb_gefree(xt,map%p_desc_Y,info) + call psb_gefree(yt,map%p_desc_Y,info) + + case default + write(psb_err_unit,*) trim(name),' Invalid descriptor input', & + & map_kind, psb_map_aggr_, psb_map_gen_linear_ + info = 1 + return + end select + + return +end subroutine psb_z_map_X2Y_vect + + +! +! Takes a vector x from space map%p_desc_Y and maps it onto +! map%p_desc_X under map%map_Y2X possibly with communication +! due to exch_bk_idx +! +subroutine psb_z_map_Y2X(alpha,x,beta,y,map,info,work) + use psb_base_mod, psb_protect_name => psb_z_map_Y2X + + implicit none + type(psb_zlinmap_type), intent(in) :: map + complex(psb_dpk_), intent(in) :: alpha,beta + complex(psb_dpk_), intent(inout) :: x(:) + complex(psb_dpk_), intent(out) :: y(:) + integer, intent(out) :: info + complex(psb_dpk_), optional :: work(:) + + ! + complex(psb_dpk_), allocatable :: xt(:), yt(:) + integer :: i, j, nr1, nc1,nr2, nc2,& + & map_kind, map_data, nr, ictxt + character(len=20), parameter :: name='psb_map_Y2X' + + info = psb_success_ + if (.not.psb_is_asb_map(map)) then + write(psb_err_unit,*) trim(name),' Invalid descriptor input' + info = 1 + return + end if + + map_kind = psb_get_map_kind(map) + + select case(map_kind) + case(psb_map_aggr_) + + ictxt = map%p_desc_X%get_context() + nr2 = map%p_desc_X%get_global_rows() + nc2 = map%p_desc_X%get_local_cols() + allocate(yt(nc2),stat=info) + if (info == psb_success_) call psb_halo(x,map%p_desc_Y,info,work=work) + if (info == psb_success_) call psb_csmm(zone,map%map_Y2X,x,zzero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_X)) then + call psb_sum(ictxt,yt(1:nr2)) + end if + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_X,info) + if (info /= psb_success_) then + write(psb_err_unit,*) trim(name),' Error from inner routines',info + info = -1 + end if + + case(psb_map_gen_linear_) + + ictxt = map%desc_X%get_context() + nr1 = map%desc_Y%get_local_rows() + nc1 = map%desc_Y%get_local_cols() + nr2 = map%desc_X%get_global_rows() + nc2 = map%desc_X%get_local_cols() + allocate(xt(nc1),yt(nc2),stat=info) + xt(1:nr1) = x(1:nr1) + if (info == psb_success_) call psb_halo(xt,map%desc_Y,info,work=work) + if (info == psb_success_) call psb_csmm(zone,map%map_Y2X,xt,zzero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_X)) then + call psb_sum(ictxt,yt(1:nr2)) + end if + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_X,info) + if (info /= psb_success_) then + write(psb_err_unit,*) trim(name),' Error from inner routines',info + info = -1 + end if + + + case default + write(psb_err_unit,*) trim(name),' Invalid descriptor input' + info = 1 + return + end select + +end subroutine psb_z_map_Y2X + +subroutine psb_z_map_Y2X_vect(alpha,x,beta,y,map,info,work) + use psb_base_mod, psb_protect_name => psb_z_map_Y2X_vect + implicit none + type(psb_zlinmap_type), intent(in) :: map + complex(psb_dpk_), intent(in) :: alpha,beta + type(psb_z_vect_type), intent(inout) :: x,y + integer, intent(out) :: info + complex(psb_dpk_), optional :: work(:) + ! + type(psb_z_vect_type) :: xt, yt + complex(psb_dpk_), allocatable :: xta(:), yta(:) + integer :: i, j, nr1, nc1,nr2, nc2,& + & map_kind, map_data, nr, ictxt + character(len=20), parameter :: name='psb_map_Y2X' + + info = psb_success_ + if (.not.psb_is_asb_map(map)) then + write(psb_err_unit,*) trim(name),' Invalid descriptor input' + info = 1 + return + end if + + map_kind = psb_get_map_kind(map) + + select case(map_kind) + case(psb_map_aggr_) + + ictxt = map%p_desc_X%get_context() + nr2 = map%p_desc_X%get_global_rows() + nc2 = map%p_desc_X%get_local_cols() + call psb_geall(yt,map%p_desc_X,info) + call psb_geasb(yt,map%p_desc_X,info,mold=y%v) + if (info == psb_success_) call psb_halo(x,map%p_desc_Y,info,work=work) + if (info == psb_success_) call psb_csmm(zone,map%map_Y2X,x,zzero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%p_desc_X)) then + yta = yt + call psb_sum(ictxt,yta(1:nr2)) + call yt%set(yta) + end if + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_X,info) + if (info /= psb_success_) then + write(psb_err_unit,*) trim(name),' Error from inner routines',info + info = -1 + end if + call psb_gefree(yt,map%p_desc_Y,info) + + case(psb_map_gen_linear_) + + ictxt = map%desc_X%get_context() + nr1 = map%desc_Y%get_local_rows() + nc1 = map%desc_Y%get_local_cols() + nr2 = map%desc_X%get_global_rows() + nc2 = map%desc_X%get_local_cols() + + call psb_geall(xt,map%p_desc_Y,info) + call psb_geasb(xt,map%p_desc_Y,info,mold=x%v) + call psb_geall(yt,map%p_desc_X,info) + call psb_geasb(yt,map%p_desc_X,info,mold=y%v) + + xta = x + call xt%set(xta(1:nr1)) + + if (info == psb_success_) call psb_halo(xt,map%desc_Y,info,work=work) + if (info == psb_success_) call psb_csmm(zone,map%map_Y2X,xt,zzero,yt,info) + if ((info == psb_success_) .and. psb_is_repl_desc(map%desc_X)) then + yta = yt + call psb_sum(ictxt,yta(1:nr2)) + call yt%set(yta) + end if + if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_X,info) + if (info /= psb_success_) then + write(psb_err_unit,*) trim(name),' Error from inner routines',info + info = -1 + end if + + call psb_gefree(xt,map%p_desc_Y,info) + call psb_gefree(yt,map%p_desc_Y,info) + + case default + write(psb_err_unit,*) trim(name),' Invalid descriptor input' + info = 1 + return + end select + +end subroutine psb_z_map_Y2X_vect + +function psb_z_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) result(this) + + use psb_base_mod, psb_protect_name => psb_z_linmap + + implicit none + type(psb_zlinmap_type) :: this + type(psb_desc_type), target :: desc_X, desc_Y + type(psb_zspmat_type), intent(in) :: map_X2Y, map_Y2X + integer, intent(in) :: map_kind + integer, intent(in), optional :: iaggr(:), naggr(:) + ! + integer :: info + character(len=20), parameter :: name='psb_linmap' + + info = psb_success_ + select case(map_kind) + case (psb_map_aggr_) + ! OK + + if (psb_is_ok_desc(desc_X)) then + this%p_desc_X=>desc_X + else + info = psb_err_pivot_too_small_ + endif + if (psb_is_ok_desc(desc_Y)) then + this%p_desc_Y=>desc_Y + else + info = psb_err_invalid_ovr_num_ + endif + if (present(iaggr)) then + if (.not.present(naggr)) then + info = 7 + else + allocate(this%iaggr(size(iaggr)),& + & this%naggr(size(naggr)), stat=info) + if (info == psb_success_) then + this%iaggr(:) = iaggr(:) + this%naggr(:) = naggr(:) + end if + end if + else + allocate(this%iaggr(0), this%naggr(0), stat=info) + end if + + case(psb_map_gen_linear_) + + if (psb_is_ok_desc(desc_X)) then + call psb_cdcpy(desc_X, this%desc_X,info) + else + info = psb_err_pivot_too_small_ + endif + if (psb_is_ok_desc(desc_Y)) then + call psb_cdcpy(desc_Y, this%desc_Y,info) + else + info = psb_err_invalid_ovr_num_ + endif + ! For a general linear map ignore iaggr,naggr + allocate(this%iaggr(0), this%naggr(0), stat=info) + + case default + write(psb_err_unit,*) 'Bad map kind into psb_linmap ',map_kind + info = 1 + end select + + if (info == psb_success_) call psb_clone(map_X2Y,this%map_X2Y,info) + if (info == psb_success_) call psb_clone(map_Y2X,this%map_Y2X,info) + if (info == psb_success_) call psb_realloc(psb_itd_data_size_,this%itd_data,info) + if (info == psb_success_) then + call psb_set_map_kind(map_kind, this) + end if + if (info /= psb_success_) then + write(psb_err_unit,*) trim(name),' Invalid descriptor input' + return + end if + +end function psb_z_linmap diff --git a/base/tools/psb_zallc.f90 b/base/tools/psb_zallc.f90 index 860013535..7d7fa6c35 100644 --- a/base/tools/psb_zallc.f90 +++ b/base/tools/psb_zallc.f90 @@ -252,3 +252,187 @@ subroutine psb_zallocv(x, desc_a,info,n) end subroutine psb_zallocv + +subroutine psb_zalloc_vect(x, desc_a,info,n) + use psb_base_mod, psb_protect_name => psb_zalloc_vect + use psi_mod + implicit none + + !....parameters... + type(psb_z_vect_type), intent(out) :: x + type(psb_desc_type), intent(in) :: desc_a + integer,intent(out) :: info + integer, optional, intent(in) :: n + + !locals + integer :: np,me,nr,i,err_act + integer :: ictxt, int_err(5) + integer :: debug_level, debug_unit + character(len=20) :: name + + info=psb_success_ + if (psb_errstatus_fatal()) return + name='psb_geall' + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt=desc_a%get_context() + + call psb_info(ictxt, me, np) + ! ....verify blacs grid correctness.. + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + !... check m and n parameters.... + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if + + ! As this is a rank-1 array, optional parameter N is actually ignored. + + !....allocate x ..... + if (psb_is_asb_desc(desc_a).or.psb_is_upd_desc(desc_a)) then + nr = max(1,desc_a%get_local_cols()) + else if (psb_is_bld_desc(desc_a)) then + nr = max(1,desc_a%get_local_rows()) + else + info = psb_err_internal_error_ + call psb_errpush(info,name,int_err,a_err='Invalid desc_a') + goto 9999 + endif + + allocate(psb_z_base_vect_type :: x%v, stat=info) + if (info == 0) call x%all(nr,info) + if (psb_errstatus_fatal()) then + info=psb_err_alloc_request_ + int_err(1)=nr + call psb_errpush(info,name,int_err,a_err='real(psb_spk_)') + goto 9999 + endif + call x%zero() + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end subroutine psb_zalloc_vect + +subroutine psb_zalloc_vect_r2(x, desc_a,info,n,lb) + use psb_base_mod, psb_protect_name => psb_zalloc_vect_r2 + use psi_mod + implicit none + + !....parameters... + type(psb_z_vect_type), allocatable, intent(out) :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer,intent(out) :: info + integer, optional, intent(in) :: n,lb + + !locals + integer :: np,me,nr,i,err_act, n_, lb_ + integer :: ictxt, int_err(5), exch(1) + integer :: debug_level, debug_unit + character(len=20) :: name + + info=psb_success_ + if (psb_errstatus_fatal()) return + name='psb_geall' + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt=desc_a%get_context() + + call psb_info(ictxt, me, np) + ! ....verify blacs grid correctness.. + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + !... check m and n parameters.... + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if + + if (present(n)) then + n_ = n + else + n_ = 1 + endif + if (present(lb)) then + lb_ = lb + else + lb_ = 1 + endif + + !global check on n parameters + if (me == psb_root_) then + exch(1)=n_ + call psb_bcast(ictxt,exch(1),root=psb_root_) + else + call psb_bcast(ictxt,exch(1),root=psb_root_) + if (exch(1) /= n_) then + info=psb_err_parm_differs_among_procs_ + int_err(1)=1 + call psb_errpush(info,name,int_err) + goto 9999 + endif + endif + ! As this is a rank-1 array, optional parameter N is actually ignored. + + !....allocate x ..... + if (desc_a%is_asb().or.desc_a%is_upd()) then + nr = max(1,desc_a%get_local_cols()) + else if (desc_a%is_bld()) then + nr = max(1,desc_a%get_local_rows()) + else + info = psb_err_internal_error_ + call psb_errpush(info,name,int_err,a_err='Invalid desc_a') + goto 9999 + endif + + allocate(x(lb_:lb_+n_-1), stat=info) + if (info == 0) then + do i=lb_, lb_+n_-1 + allocate(psb_z_base_vect_type :: x(i)%v, stat=info) + if (info == 0) call x(i)%all(nr,info) + if (info == 0) call x(i)%zero() + if (info /= 0) exit + end do + end if + if (psb_errstatus_fatal()) then + info=psb_err_alloc_request_ + int_err(1)=nr + call psb_errpush(info,name,int_err,a_err='real(psb_spk_)') + goto 9999 + endif + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end subroutine psb_zalloc_vect_r2 diff --git a/base/tools/psb_zasb.f90 b/base/tools/psb_zasb.f90 index 2f2977072..5a3504aa7 100644 --- a/base/tools/psb_zasb.f90 +++ b/base/tools/psb_zasb.f90 @@ -249,3 +249,149 @@ subroutine psb_zasbv(x, desc_a, info) end subroutine psb_zasbv + +subroutine psb_zasb_vect(x, desc_a, info, mold) + use psb_base_mod, psb_protect_name => psb_zasb_vect + implicit none + + type(psb_desc_type), intent(in) :: desc_a + type(psb_z_vect_type), intent(inout) :: x + integer, intent(out) :: info + class(psb_z_base_vect_type), intent(in), optional :: mold + + ! local variables + integer :: ictxt,np,me + integer :: int_err(5), i1sz,nrow,ncol, err_act + integer :: debug_level, debug_unit + character(len=20) :: name,ch_err + + info = psb_success_ + if (psb_errstatus_fatal()) return + + int_err(1) = 0 + name = 'psb_zgeasb_v' + + ictxt = desc_a%get_context() + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + call psb_info(ictxt, me, np) + + ! ....verify blacs grid correctness.. + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + else if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if + + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),': sizes: ',nrow,ncol + + call x%asb(ncol,info) + ! ..update halo elements.. + call psb_halo(x,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_halo') + goto 9999 + end if + if (present(mold)) then + call x%cnv(mold) + end if + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),': end' + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end subroutine psb_zasb_vect + + +subroutine psb_zasb_vect_r2(x, desc_a, info, mold) + use psb_base_mod, psb_protect_name => psb_zasb_vect_r2 + implicit none + + type(psb_desc_type), intent(in) :: desc_a + type(psb_z_vect_type), intent(inout) :: x(:) + integer, intent(out) :: info + class(psb_z_base_vect_type), intent(in), optional :: mold + + ! local variables + integer :: ictxt,np,me, i, n + integer :: int_err(5), i1sz,nrow,ncol, err_act + integer :: debug_level, debug_unit + character(len=20) :: name,ch_err + + info = psb_success_ + if (psb_errstatus_fatal()) return + + int_err(1) = 0 + name = 'psb_zgeasb_v' + + ictxt = desc_a%get_context() + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + call psb_info(ictxt, me, np) + + ! ....verify blacs grid correctness.. + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + else if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if + + nrow = desc_a%get_local_rows() + ncol = desc_a%get_local_cols() + n = size(x) + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),': sizes: ',nrow,ncol + + do i=1, n + call x(i)%asb(ncol,info) + if (info /= 0) exit + ! ..update halo elements.. + call psb_halo(x(i),desc_a,info) + if (info /= 0) exit + if (present(mold)) then + call x(i)%cnv(mold) + end if + end do + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_halo') + goto 9999 + end if + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),': end' + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end subroutine psb_zasb_vect_r2 diff --git a/base/tools/psb_zfree.f90 b/base/tools/psb_zfree.f90 index 18e235c37..6bef8a7f6 100644 --- a/base/tools/psb_zfree.f90 +++ b/base/tools/psb_zfree.f90 @@ -170,3 +170,116 @@ subroutine psb_zfreev(x, desc_a, info) return end subroutine psb_zfreev + +subroutine psb_zfree_vect(x, desc_a, info) + use psb_base_mod, psb_protect_name => psb_zfree_vect + implicit none + !....parameters... + type(psb_z_vect_type), intent(inout) :: x + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + !...locals.... + integer :: ictxt,np,me,err_act + character(len=20) :: name + + + info=psb_success_ + if (psb_errstatus_fatal()) return + call psb_erractionsave(err_act) + name='psb_zfreev' + + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if + ictxt = desc_a%get_context() + + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + call x%free(info) + + if (info /= psb_no_err_) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + endif + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end subroutine psb_zfree_vect + +subroutine psb_zfree_vect_r2(x, desc_a, info) + use psb_base_mod, psb_protect_name => psb_zfree_vect_r2 + implicit none + !....parameters... + type(psb_z_vect_type), allocatable, intent(inout) :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + !...locals.... + integer :: ictxt,np,me,err_act, i + character(len=20) :: name + + + info=psb_success_ + if (psb_errstatus_fatal()) return + call psb_erractionsave(err_act) + name='psb_zfreev' + + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if + ictxt = desc_a%get_context() + + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + + do i=lbound(x,1),ubound(x,1) + call x(i)%free(info) + if (info /= 0) exit + end do + if (info == 0) deallocate(x,stat=info) + if (info /= psb_no_err_) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + endif + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end subroutine psb_zfree_vect_r2 diff --git a/base/tools/psb_zins.f90 b/base/tools/psb_zins.f90 index d1f0190bd..38fff1705 100644 --- a/base/tools/psb_zins.f90 +++ b/base/tools/psb_zins.f90 @@ -178,6 +178,230 @@ subroutine psb_zinsvi(m, irw, val, x, desc_a, info, dupl) end subroutine psb_zinsvi +subroutine psb_zins_vect(m, irw, val, x, desc_a, info, dupl) + use psb_base_mod, psb_protect_name => psb_zins_vect + use psi_mod + implicit none + + ! m rows number of submatrix belonging to val to be inserted + ! ix x global-row corresponding to position at which val submatrix + ! must be inserted + + !....parameters... + integer, intent(in) :: m + integer, intent(in) :: irw(:) + complex(psb_dpk_), intent(in) :: val(:) + type(psb_z_vect_type), intent(inout) :: x + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, optional, intent(in) :: dupl + + !locals..... + integer :: ictxt,i,& + & loc_rows,loc_cols,mglob,err_act, int_err(5) + integer :: np, me, dupl_ + integer, allocatable :: irl(:) + character(len=20) :: name + + if (psb_errstatus_fatal()) return + info=psb_success_ + call psb_erractionsave(err_act) + name = 'psb_zinsvi' + + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if + + ictxt = desc_a%get_context() + + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + + !... check parameters.... + if (m < 0) then + info = psb_err_iarg_neg_ + int_err(1) = 1 + int_err(2) = m + call psb_errpush(info,name,int_err) + goto 9999 + else if (x%get_nrows() < desc_a%get_local_rows()) then + info = 310 + int_err(1) = 5 + int_err(2) = 4 + call psb_errpush(info,name,int_err) + goto 9999 + endif + + if (m == 0) return + loc_rows = desc_a%get_local_rows() + loc_cols = desc_a%get_local_cols() + mglob = desc_a%get_global_rows() + + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + + allocate(irl(m),stat=info) + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + endif + + if (present(dupl)) then + dupl_ = dupl + else + dupl_ = psb_dupl_ovwrt_ + endif + + call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + + call x%ins(m,irl,val,dupl_,info) + if (info /= 0) then + call psb_errpush(info,name) + goto 9999 + end if + deallocate(irl) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_ret_) then + return + else + call psb_error(ictxt) + end if + return + +end subroutine psb_zins_vect + +subroutine psb_zins_vect_r2(m, irw, val, x, desc_a, info, dupl) + use psb_base_mod, psb_protect_name => psb_zins_vect_r2 + use psi_mod + implicit none + + ! m rows number of submatrix belonging to val to be inserted + ! ix x global-row corresponding to position at which val submatrix + ! must be inserted + + !....parameters... + integer, intent(in) :: m + integer, intent(in) :: irw(:) + complex(psb_dpk_), intent(in) :: val(:,:) + type(psb_z_vect_type), intent(inout) :: x(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + integer, optional, intent(in) :: dupl + + !locals..... + integer :: ictxt,i,& + & loc_rows,loc_cols,mglob,err_act, int_err(5), n + integer :: np, me, dupl_ + integer, allocatable :: irl(:) + character(len=20) :: name + + if (psb_errstatus_fatal()) return + info=psb_success_ + call psb_erractionsave(err_act) + name = 'psb_zinsvi' + + if (.not.desc_a%is_ok()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + end if + + ictxt = desc_a%get_context() + + call psb_info(ictxt, me, np) + if (np == -1) then + info = psb_err_context_error_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x(1)%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + !... check parameters.... + if (m < 0) then + info = psb_err_iarg_neg_ + int_err(1) = 1 + int_err(2) = m + call psb_errpush(info,name,int_err) + goto 9999 + else if (x(1)%get_nrows() < desc_a%get_local_rows()) then + info = 310 + int_err(1) = 5 + int_err(2) = 4 + call psb_errpush(info,name,int_err) + goto 9999 + endif + + if (m == 0) return + loc_rows = desc_a%get_local_rows() + loc_cols = desc_a%get_local_cols() + mglob = desc_a%get_global_rows() + + + + n = min(size(x),size(val,2)) + allocate(irl(m),stat=info) + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + endif + + if (present(dupl)) then + dupl_ = dupl + else + dupl_ = psb_dupl_ovwrt_ + endif + + call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + do i=1,n + if (.not.allocated(x(i)%v)) info = psb_err_invalid_vect_state_ + if (info == 0) call x(i)%ins(m,irl,val(:,i),dupl_,info) + if (info /= 0) exit + end do + if (info /= 0) then + call psb_errpush(info,name) + goto 9999 + end if + deallocate(irl) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_ret_) then + return + else + call psb_error(ictxt) + end if + return + +end subroutine psb_zins_vect_r2 + + !!$ !!$ Parallel Sparse BLAS version 3.0 diff --git a/config/pac.m4 b/config/pac.m4 index bc9c64e12..846ecc026 100644 --- a/config/pac.m4 +++ b/config/pac.m4 @@ -150,10 +150,10 @@ ac_exeext='' ac_ext='F' ac_link='${MPIFC-$FC} -o conftest${ac_exeext} $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' dnl Warning : square brackets are EVIL! -[AC_MSG_CHECKING([GNU Fortran version at least 4.3]) +[AC_MSG_CHECKING([GNU Fortran version at least 4.6]) cat > conftest.$ac_ext <= 4 && __GNUC_MINOR__ >= 3 ) || ( __GNUC__ > 4 ) +#if ( __GNUC__ >= 4 && __GNUC_MINOR__ >= 6 ) || ( __GNUC__ > 4 ) print *, "ok" #else this program will fail diff --git a/configure b/configure index d60b80a00..3f5714212 100755 --- a/configure +++ b/configure @@ -5439,11 +5439,11 @@ if test "X$psblas_cv_fc" == "Xgcc" ; then ac_exeext='' ac_ext='F' ac_link='${MPIFC-$FC} -o conftest${ac_exeext} $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking GNU Fortran version at least 4.3" >&5 -$as_echo_n "checking GNU Fortran version at least 4.3... " >&6; } +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking GNU Fortran version at least 4.6" >&5 +$as_echo_n "checking GNU Fortran version at least 4.6... " >&6; } cat > conftest.$ac_ext <= 4 && __GNUC_MINOR__ >= 3 ) || ( __GNUC__ > 4 ) +#if ( __GNUC__ >= 4 && __GNUC_MINOR__ >= 6 ) || ( __GNUC__ > 4 ) print *, "ok" #else this program will fail @@ -5465,7 +5465,7 @@ $as_echo " no." >&6; } echo "configure: failed program was:" >&5 cat conftest.$ac_ext >&5 rm -rf conftest* - as_fn_error $? "Sorry, we require GNU Fortran 4.3 or later." "$LINENO" 5 + as_fn_error $? "Sorry, we require GNU Fortran 4.6 or later." "$LINENO" 5 fi rm -f conftest* diff --git a/configure.ac b/configure.ac index 47bd8dee6..d2ccfd110 100755 --- a/configure.ac +++ b/configure.ac @@ -252,7 +252,7 @@ fi if test "X$psblas_cv_fc" == "Xgcc" ; then PAC_HAVE_MODERN_GFORTRAN( [], - [AC_MSG_ERROR([Sorry, we require GNU Fortran 4.3 or later.])] + [AC_MSG_ERROR([Sorry, we require GNU Fortran 4.6 or later.])] ) fi # TODO : SEE _AC_PROG_FC_V diff --git a/docs/html/footnode.html b/docs/html/footnode.html index 2979db8b1..e5c4ad8f6 100644 --- a/docs/html/footnode.html +++ b/docs/html/footnode.html @@ -18,7 +18,7 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + @@ -104,8 +104,8 @@ sample scatter/gather routines. . -
... follows3
+
... follows3
The string is case-insensitive
.
diff --git a/docs/html/img1.png b/docs/html/img1.png
index 2bcd8b2c6..f20c57531 100644
Binary files a/docs/html/img1.png and b/docs/html/img1.png differ
diff --git a/docs/html/img10.png b/docs/html/img10.png
index 2049ac157..f17919431 100644
Binary files a/docs/html/img10.png and b/docs/html/img10.png differ
diff --git a/docs/html/img100.png b/docs/html/img100.png
index 985ac48f8..e4114dd3b 100644
Binary files a/docs/html/img100.png and b/docs/html/img100.png differ
diff --git a/docs/html/img101.png b/docs/html/img101.png
index 503b1ab62..fd2f32227 100644
Binary files a/docs/html/img101.png and b/docs/html/img101.png differ
diff --git a/docs/html/img102.png b/docs/html/img102.png
index 2f53c222d..25c0fe219 100644
Binary files a/docs/html/img102.png and b/docs/html/img102.png differ
diff --git a/docs/html/img103.png b/docs/html/img103.png
index b83a8d66b..6ee756335 100644
Binary files a/docs/html/img103.png and b/docs/html/img103.png differ
diff --git a/docs/html/img104.png b/docs/html/img104.png
index de35d7fad..c1d8fa3f3 100644
Binary files a/docs/html/img104.png and b/docs/html/img104.png differ
diff --git a/docs/html/img105.png b/docs/html/img105.png
index d974a444e..605df8a03 100644
Binary files a/docs/html/img105.png and b/docs/html/img105.png differ
diff --git a/docs/html/img106.png b/docs/html/img106.png
index 92823e6ad..48478479e 100644
Binary files a/docs/html/img106.png and b/docs/html/img106.png differ
diff --git a/docs/html/img107.png b/docs/html/img107.png
index c352f896b..f0a8e0d93 100644
Binary files a/docs/html/img107.png and b/docs/html/img107.png differ
diff --git a/docs/html/img108.png b/docs/html/img108.png
index f21abed13..67fafc48f 100644
Binary files a/docs/html/img108.png and b/docs/html/img108.png differ
diff --git a/docs/html/img109.png b/docs/html/img109.png
index 60d8dfe12..62b29ec8c 100644
Binary files a/docs/html/img109.png and b/docs/html/img109.png differ
diff --git a/docs/html/img11.png b/docs/html/img11.png
index 74543e1ce..300e48250 100644
Binary files a/docs/html/img11.png and b/docs/html/img11.png differ
diff --git a/docs/html/img110.png b/docs/html/img110.png
index 0f14d8306..bc3978ffb 100644
Binary files a/docs/html/img110.png and b/docs/html/img110.png differ
diff --git a/docs/html/img111.png b/docs/html/img111.png
index ffb003b8f..9a0f8c4d8 100644
Binary files a/docs/html/img111.png and b/docs/html/img111.png differ
diff --git a/docs/html/img112.png b/docs/html/img112.png
index 04caf6e50..b00a8cd8e 100644
Binary files a/docs/html/img112.png and b/docs/html/img112.png differ
diff --git a/docs/html/img113.png b/docs/html/img113.png
index 47f71ed5a..d5fd8d1b3 100644
Binary files a/docs/html/img113.png and b/docs/html/img113.png differ
diff --git a/docs/html/img114.png b/docs/html/img114.png
index 5cfc26625..8b8bbce78 100644
Binary files a/docs/html/img114.png and b/docs/html/img114.png differ
diff --git a/docs/html/img115.png b/docs/html/img115.png
index 988e80e20..cc0a9a344 100644
Binary files a/docs/html/img115.png and b/docs/html/img115.png differ
diff --git a/docs/html/img116.png b/docs/html/img116.png
index 343909734..97d08ff9c 100644
Binary files a/docs/html/img116.png and b/docs/html/img116.png differ
diff --git a/docs/html/img117.png b/docs/html/img117.png
index be0d5a7db..9ec826b83 100644
Binary files a/docs/html/img117.png and b/docs/html/img117.png differ
diff --git a/docs/html/img118.png b/docs/html/img118.png
index 101ad4d64..195c0224f 100644
Binary files a/docs/html/img118.png and b/docs/html/img118.png differ
diff --git a/docs/html/img119.png b/docs/html/img119.png
index a8d143ed6..f8ecccb64 100644
Binary files a/docs/html/img119.png and b/docs/html/img119.png differ
diff --git a/docs/html/img12.png b/docs/html/img12.png
index 9d510bb96..b6e1ab70d 100644
Binary files a/docs/html/img12.png and b/docs/html/img12.png differ
diff --git a/docs/html/img120.png b/docs/html/img120.png
index faeee6e4b..2c463039e 100644
Binary files a/docs/html/img120.png and b/docs/html/img120.png differ
diff --git a/docs/html/img121.png b/docs/html/img121.png
index 18112b72e..017eea044 100644
Binary files a/docs/html/img121.png and b/docs/html/img121.png differ
diff --git a/docs/html/img122.png b/docs/html/img122.png
index f51cb667d..68bc1a028 100644
Binary files a/docs/html/img122.png and b/docs/html/img122.png differ
diff --git a/docs/html/img123.png b/docs/html/img123.png
index 83d7a517e..69253a782 100644
Binary files a/docs/html/img123.png and b/docs/html/img123.png differ
diff --git a/docs/html/img124.png b/docs/html/img124.png
index 4a97c54d9..90d8d9a96 100644
Binary files a/docs/html/img124.png and b/docs/html/img124.png differ
diff --git a/docs/html/img125.png b/docs/html/img125.png
index 518625306..798e78643 100644
Binary files a/docs/html/img125.png and b/docs/html/img125.png differ
diff --git a/docs/html/img126.png b/docs/html/img126.png
index d677cf778..fcdbb64f9 100644
Binary files a/docs/html/img126.png and b/docs/html/img126.png differ
diff --git a/docs/html/img127.png b/docs/html/img127.png
index 77dcbe5b4..1fe14d467 100644
Binary files a/docs/html/img127.png and b/docs/html/img127.png differ
diff --git a/docs/html/img128.png b/docs/html/img128.png
index 2dc97d670..5032beaf5 100644
Binary files a/docs/html/img128.png and b/docs/html/img128.png differ
diff --git a/docs/html/img129.png b/docs/html/img129.png
index 5976bb157..47913ee15 100644
Binary files a/docs/html/img129.png and b/docs/html/img129.png differ
diff --git a/docs/html/img13.png b/docs/html/img13.png
index 817ef1d53..0b64d387e 100644
Binary files a/docs/html/img13.png and b/docs/html/img13.png differ
diff --git a/docs/html/img130.png b/docs/html/img130.png
index 69a41dd72..2a4a67cc7 100644
Binary files a/docs/html/img130.png and b/docs/html/img130.png differ
diff --git a/docs/html/img131.png b/docs/html/img131.png
index fad10afc5..f63e861ee 100644
Binary files a/docs/html/img131.png and b/docs/html/img131.png differ
diff --git a/docs/html/img132.png b/docs/html/img132.png
index 865798ac3..c07a1bcd9 100644
Binary files a/docs/html/img132.png and b/docs/html/img132.png differ
diff --git a/docs/html/img133.png b/docs/html/img133.png
index 0417d2c41..6b244fdf3 100644
Binary files a/docs/html/img133.png and b/docs/html/img133.png differ
diff --git a/docs/html/img134.png b/docs/html/img134.png
index f5338df36..850dcba0e 100644
Binary files a/docs/html/img134.png and b/docs/html/img134.png differ
diff --git a/docs/html/img135.png b/docs/html/img135.png
index 0401ba94f..a733cc999 100644
Binary files a/docs/html/img135.png and b/docs/html/img135.png differ
diff --git a/docs/html/img136.png b/docs/html/img136.png
index bb8f30e98..9ffee9ad8 100644
Binary files a/docs/html/img136.png and b/docs/html/img136.png differ
diff --git a/docs/html/img137.png b/docs/html/img137.png
index ccc43d90b..6928567c9 100644
Binary files a/docs/html/img137.png and b/docs/html/img137.png differ
diff --git a/docs/html/img138.png b/docs/html/img138.png
index e69de29bb..df82028c9 100644
Binary files a/docs/html/img138.png and b/docs/html/img138.png differ
diff --git a/docs/html/img14.png b/docs/html/img14.png
index a4bf654b3..e5fcc49cb 100644
Binary files a/docs/html/img14.png and b/docs/html/img14.png differ
diff --git a/docs/html/img140.png b/docs/html/img140.png
index 12936326f..e69de29bb 100644
Binary files a/docs/html/img140.png and b/docs/html/img140.png differ
diff --git a/docs/html/img141.png b/docs/html/img141.png
index 38263b799..43dfe1694 100644
Binary files a/docs/html/img141.png and b/docs/html/img141.png differ
diff --git a/docs/html/img142.png b/docs/html/img142.png
index 98984bad5..e1180aca1 100644
Binary files a/docs/html/img142.png and b/docs/html/img142.png differ
diff --git a/docs/html/img143.png b/docs/html/img143.png
index 8df7b6879..9eaf8c619 100644
Binary files a/docs/html/img143.png and b/docs/html/img143.png differ
diff --git a/docs/html/img144.png b/docs/html/img144.png
index d5054576c..a80d3c32d 100644
Binary files a/docs/html/img144.png and b/docs/html/img144.png differ
diff --git a/docs/html/img145.png b/docs/html/img145.png
index d57061ccb..0cc86fe7a 100644
Binary files a/docs/html/img145.png and b/docs/html/img145.png differ
diff --git a/docs/html/img146.png b/docs/html/img146.png
index 0e2bf7fa3..554b59b21 100644
Binary files a/docs/html/img146.png and b/docs/html/img146.png differ
diff --git a/docs/html/img147.png b/docs/html/img147.png
index 09d1d7962..a2e86fc07 100644
Binary files a/docs/html/img147.png and b/docs/html/img147.png differ
diff --git a/docs/html/img148.png b/docs/html/img148.png
index 41988bf54..ee9568425 100644
Binary files a/docs/html/img148.png and b/docs/html/img148.png differ
diff --git a/docs/html/img149.png b/docs/html/img149.png
index 159bf1eb8..75d19edba 100644
Binary files a/docs/html/img149.png and b/docs/html/img149.png differ
diff --git a/docs/html/img15.png b/docs/html/img15.png
index 49ee48d23..c2f46667f 100644
Binary files a/docs/html/img15.png and b/docs/html/img15.png differ
diff --git a/docs/html/img16.png b/docs/html/img16.png
index 5328d7ff4..55c3442a4 100644
Binary files a/docs/html/img16.png and b/docs/html/img16.png differ
diff --git a/docs/html/img17.png b/docs/html/img17.png
index 9245dd3ec..8db5ceddf 100644
Binary files a/docs/html/img17.png and b/docs/html/img17.png differ
diff --git a/docs/html/img18.png b/docs/html/img18.png
index a674f6be4..0ab65bf03 100644
Binary files a/docs/html/img18.png and b/docs/html/img18.png differ
diff --git a/docs/html/img2.png b/docs/html/img2.png
index 8f88e3bfa..42952293f 100644
Binary files a/docs/html/img2.png and b/docs/html/img2.png differ
diff --git a/docs/html/img20.png b/docs/html/img20.png
index 0353774d4..2dbb91458 100644
Binary files a/docs/html/img20.png and b/docs/html/img20.png differ
diff --git a/docs/html/img22.png b/docs/html/img22.png
index 49d1ccae1..0f8a878c6 100644
Binary files a/docs/html/img22.png and b/docs/html/img22.png differ
diff --git a/docs/html/img23.png b/docs/html/img23.png
index cf820eabc..c1d195f73 100644
Binary files a/docs/html/img23.png and b/docs/html/img23.png differ
diff --git a/docs/html/img24.png b/docs/html/img24.png
index 309dc6000..da5b90527 100644
Binary files a/docs/html/img24.png and b/docs/html/img24.png differ
diff --git a/docs/html/img26.png b/docs/html/img26.png
index e98a26a45..e69de29bb 100644
Binary files a/docs/html/img26.png and b/docs/html/img26.png differ
diff --git a/docs/html/img27.png b/docs/html/img27.png
index 9f8a50df3..cf98cfe06 100644
Binary files a/docs/html/img27.png and b/docs/html/img27.png differ
diff --git a/docs/html/img28.png b/docs/html/img28.png
index bd2bea65c..09de5cc53 100644
Binary files a/docs/html/img28.png and b/docs/html/img28.png differ
diff --git a/docs/html/img29.png b/docs/html/img29.png
index b8c723d5e..7dac43e21 100644
Binary files a/docs/html/img29.png and b/docs/html/img29.png differ
diff --git a/docs/html/img3.png b/docs/html/img3.png
index 6878d2419..81958a741 100644
Binary files a/docs/html/img3.png and b/docs/html/img3.png differ
diff --git a/docs/html/img30.png b/docs/html/img30.png
index 23642ca77..9430fcbe6 100644
Binary files a/docs/html/img30.png and b/docs/html/img30.png differ
diff --git a/docs/html/img31.png b/docs/html/img31.png
index 1d343a4e6..aa48fcecc 100644
Binary files a/docs/html/img31.png and b/docs/html/img31.png differ
diff --git a/docs/html/img32.png b/docs/html/img32.png
index 00aba8b7d..8b0313496 100644
Binary files a/docs/html/img32.png and b/docs/html/img32.png differ
diff --git a/docs/html/img33.png b/docs/html/img33.png
index e554c45f7..aa4a804d3 100644
Binary files a/docs/html/img33.png and b/docs/html/img33.png differ
diff --git a/docs/html/img34.png b/docs/html/img34.png
index 7dfb34470..1a3431668 100644
Binary files a/docs/html/img34.png and b/docs/html/img34.png differ
diff --git a/docs/html/img35.png b/docs/html/img35.png
index 0cafba56f..a0f610300 100644
Binary files a/docs/html/img35.png and b/docs/html/img35.png differ
diff --git a/docs/html/img36.png b/docs/html/img36.png
index e341cc952..a758b5013 100644
Binary files a/docs/html/img36.png and b/docs/html/img36.png differ
diff --git a/docs/html/img37.png b/docs/html/img37.png
index e1c0218c1..5ed5aee4f 100644
Binary files a/docs/html/img37.png and b/docs/html/img37.png differ
diff --git a/docs/html/img38.png b/docs/html/img38.png
index 9528520c2..71286e309 100644
Binary files a/docs/html/img38.png and b/docs/html/img38.png differ
diff --git a/docs/html/img39.png b/docs/html/img39.png
index d18c1037c..4ae3794e5 100644
Binary files a/docs/html/img39.png and b/docs/html/img39.png differ
diff --git a/docs/html/img4.png b/docs/html/img4.png
index cb98a0589..0d3edf21d 100644
Binary files a/docs/html/img4.png and b/docs/html/img4.png differ
diff --git a/docs/html/img40.png b/docs/html/img40.png
index fb967761f..c00b10d4e 100644
Binary files a/docs/html/img40.png and b/docs/html/img40.png differ
diff --git a/docs/html/img41.png b/docs/html/img41.png
index ef5546ead..fc9080121 100644
Binary files a/docs/html/img41.png and b/docs/html/img41.png differ
diff --git a/docs/html/img42.png b/docs/html/img42.png
index 6e0c97fda..227f4a45e 100644
Binary files a/docs/html/img42.png and b/docs/html/img42.png differ
diff --git a/docs/html/img43.png b/docs/html/img43.png
index 51da0ffda..92e6525b8 100644
Binary files a/docs/html/img43.png and b/docs/html/img43.png differ
diff --git a/docs/html/img44.png b/docs/html/img44.png
index 911db80b5..83b6d032e 100644
Binary files a/docs/html/img44.png and b/docs/html/img44.png differ
diff --git a/docs/html/img45.png b/docs/html/img45.png
index e1a29cbd0..9ea3351a4 100644
Binary files a/docs/html/img45.png and b/docs/html/img45.png differ
diff --git a/docs/html/img46.png b/docs/html/img46.png
index 262d85313..74259acf5 100644
Binary files a/docs/html/img46.png and b/docs/html/img46.png differ
diff --git a/docs/html/img47.png b/docs/html/img47.png
index 0e462a32c..daed562ba 100644
Binary files a/docs/html/img47.png and b/docs/html/img47.png differ
diff --git a/docs/html/img48.png b/docs/html/img48.png
index 8d80e5be5..507614678 100644
Binary files a/docs/html/img48.png and b/docs/html/img48.png differ
diff --git a/docs/html/img49.png b/docs/html/img49.png
index 0913945f1..a6a250ad4 100644
Binary files a/docs/html/img49.png and b/docs/html/img49.png differ
diff --git a/docs/html/img5.png b/docs/html/img5.png
index c46a3819d..b2f5b3611 100644
Binary files a/docs/html/img5.png and b/docs/html/img5.png differ
diff --git a/docs/html/img50.png b/docs/html/img50.png
index dcd7f1085..c6870ddb4 100644
Binary files a/docs/html/img50.png and b/docs/html/img50.png differ
diff --git a/docs/html/img51.png b/docs/html/img51.png
index 3d693307e..086639b39 100644
Binary files a/docs/html/img51.png and b/docs/html/img51.png differ
diff --git a/docs/html/img52.png b/docs/html/img52.png
index 418f2429a..6577cec8d 100644
Binary files a/docs/html/img52.png and b/docs/html/img52.png differ
diff --git a/docs/html/img53.png b/docs/html/img53.png
index 15dbb2d12..e3ca633ab 100644
Binary files a/docs/html/img53.png and b/docs/html/img53.png differ
diff --git a/docs/html/img54.png b/docs/html/img54.png
index 9849391fd..6e6a2fab3 100644
Binary files a/docs/html/img54.png and b/docs/html/img54.png differ
diff --git a/docs/html/img55.png b/docs/html/img55.png
index be49db315..6daecc86f 100644
Binary files a/docs/html/img55.png and b/docs/html/img55.png differ
diff --git a/docs/html/img56.png b/docs/html/img56.png
index 6ea93c9e1..984ac7b2b 100644
Binary files a/docs/html/img56.png and b/docs/html/img56.png differ
diff --git a/docs/html/img57.png b/docs/html/img57.png
index 9a8263acc..81b66db47 100644
Binary files a/docs/html/img57.png and b/docs/html/img57.png differ
diff --git a/docs/html/img58.png b/docs/html/img58.png
index 7ea61bee7..919319cce 100644
Binary files a/docs/html/img58.png and b/docs/html/img58.png differ
diff --git a/docs/html/img59.png b/docs/html/img59.png
index 09e8cb6cc..f759dd46a 100644
Binary files a/docs/html/img59.png and b/docs/html/img59.png differ
diff --git a/docs/html/img6.png b/docs/html/img6.png
index 28b477866..58a0b450d 100644
Binary files a/docs/html/img6.png and b/docs/html/img6.png differ
diff --git a/docs/html/img60.png b/docs/html/img60.png
index 4e8a4e168..6b825d668 100644
Binary files a/docs/html/img60.png and b/docs/html/img60.png differ
diff --git a/docs/html/img61.png b/docs/html/img61.png
index b5b74989d..6cdf6149c 100644
Binary files a/docs/html/img61.png and b/docs/html/img61.png differ
diff --git a/docs/html/img62.png b/docs/html/img62.png
index e121e0d8d..f73e47fab 100644
Binary files a/docs/html/img62.png and b/docs/html/img62.png differ
diff --git a/docs/html/img63.png b/docs/html/img63.png
index e6a5b6cd1..1ec88bf66 100644
Binary files a/docs/html/img63.png and b/docs/html/img63.png differ
diff --git a/docs/html/img64.png b/docs/html/img64.png
index 6ce9093ea..8e1ae26a8 100644
Binary files a/docs/html/img64.png and b/docs/html/img64.png differ
diff --git a/docs/html/img65.png b/docs/html/img65.png
index 7cb080adf..6ce9093ea 100644
Binary files a/docs/html/img65.png and b/docs/html/img65.png differ
diff --git a/docs/html/img66.png b/docs/html/img66.png
index 9b5e36ea4..be77fbe2a 100644
Binary files a/docs/html/img66.png and b/docs/html/img66.png differ
diff --git a/docs/html/img67.png b/docs/html/img67.png
index 5c11fa45d..b36bd89cf 100644
Binary files a/docs/html/img67.png and b/docs/html/img67.png differ
diff --git a/docs/html/img68.png b/docs/html/img68.png
index d9049fe70..e85b77f0e 100644
Binary files a/docs/html/img68.png and b/docs/html/img68.png differ
diff --git a/docs/html/img69.png b/docs/html/img69.png
index 5060d61f0..4f8dbfd9c 100644
Binary files a/docs/html/img69.png and b/docs/html/img69.png differ
diff --git a/docs/html/img7.png b/docs/html/img7.png
index 34864f251..30a396992 100644
Binary files a/docs/html/img7.png and b/docs/html/img7.png differ
diff --git a/docs/html/img70.png b/docs/html/img70.png
index 432763a50..11b3c242b 100644
Binary files a/docs/html/img70.png and b/docs/html/img70.png differ
diff --git a/docs/html/img71.png b/docs/html/img71.png
index 0f133fbf4..30dbd7718 100644
Binary files a/docs/html/img71.png and b/docs/html/img71.png differ
diff --git a/docs/html/img72.png b/docs/html/img72.png
index e344cde87..2a8221eca 100644
Binary files a/docs/html/img72.png and b/docs/html/img72.png differ
diff --git a/docs/html/img73.png b/docs/html/img73.png
index 18a82590a..5b3493320 100644
Binary files a/docs/html/img73.png and b/docs/html/img73.png differ
diff --git a/docs/html/img74.png b/docs/html/img74.png
index b9c750c26..2f029ed72 100644
Binary files a/docs/html/img74.png and b/docs/html/img74.png differ
diff --git a/docs/html/img75.png b/docs/html/img75.png
index 29f556d6b..e617c4da6 100644
Binary files a/docs/html/img75.png and b/docs/html/img75.png differ
diff --git a/docs/html/img76.png b/docs/html/img76.png
index 5fd95a8c1..19eb28999 100644
Binary files a/docs/html/img76.png and b/docs/html/img76.png differ
diff --git a/docs/html/img77.png b/docs/html/img77.png
index ab90c16de..2111312c7 100644
Binary files a/docs/html/img77.png and b/docs/html/img77.png differ
diff --git a/docs/html/img78.png b/docs/html/img78.png
index c4b1412a5..42db87649 100644
Binary files a/docs/html/img78.png and b/docs/html/img78.png differ
diff --git a/docs/html/img79.png b/docs/html/img79.png
index f30e3ea6f..372377474 100644
Binary files a/docs/html/img79.png and b/docs/html/img79.png differ
diff --git a/docs/html/img8.png b/docs/html/img8.png
index 0875275f0..6e67241da 100644
Binary files a/docs/html/img8.png and b/docs/html/img8.png differ
diff --git a/docs/html/img80.png b/docs/html/img80.png
index b286bba5e..337d43ee3 100644
Binary files a/docs/html/img80.png and b/docs/html/img80.png differ
diff --git a/docs/html/img81.png b/docs/html/img81.png
index b10c809ac..af302e8bd 100644
Binary files a/docs/html/img81.png and b/docs/html/img81.png differ
diff --git a/docs/html/img82.png b/docs/html/img82.png
index 0ee708a9d..36891148d 100644
Binary files a/docs/html/img82.png and b/docs/html/img82.png differ
diff --git a/docs/html/img83.png b/docs/html/img83.png
index ef89bdfba..ffe4cf524 100644
Binary files a/docs/html/img83.png and b/docs/html/img83.png differ
diff --git a/docs/html/img84.png b/docs/html/img84.png
index 617901509..7dee1cf43 100644
Binary files a/docs/html/img84.png and b/docs/html/img84.png differ
diff --git a/docs/html/img85.png b/docs/html/img85.png
index e0dd7dffe..13f0a8216 100644
Binary files a/docs/html/img85.png and b/docs/html/img85.png differ
diff --git a/docs/html/img86.png b/docs/html/img86.png
index 3ffa14f5b..0ecdd7b6e 100644
Binary files a/docs/html/img86.png and b/docs/html/img86.png differ
diff --git a/docs/html/img87.png b/docs/html/img87.png
index a4793c56f..e7a86242b 100644
Binary files a/docs/html/img87.png and b/docs/html/img87.png differ
diff --git a/docs/html/img88.png b/docs/html/img88.png
index c1e8d746b..4b39f077c 100644
Binary files a/docs/html/img88.png and b/docs/html/img88.png differ
diff --git a/docs/html/img89.png b/docs/html/img89.png
index 37a6ec01e..72d4c328e 100644
Binary files a/docs/html/img89.png and b/docs/html/img89.png differ
diff --git a/docs/html/img9.png b/docs/html/img9.png
index a7b5737a0..f18f8313f 100644
Binary files a/docs/html/img9.png and b/docs/html/img9.png differ
diff --git a/docs/html/img90.png b/docs/html/img90.png
index da9d1a456..97c77ca2b 100644
Binary files a/docs/html/img90.png and b/docs/html/img90.png differ
diff --git a/docs/html/img91.png b/docs/html/img91.png
index 84ab80b6a..f89a8e47a 100644
Binary files a/docs/html/img91.png and b/docs/html/img91.png differ
diff --git a/docs/html/img92.png b/docs/html/img92.png
index ae2c4cd80..0802142aa 100644
Binary files a/docs/html/img92.png and b/docs/html/img92.png differ
diff --git a/docs/html/img93.png b/docs/html/img93.png
index 2abf9ed6c..7ae3977fe 100644
Binary files a/docs/html/img93.png and b/docs/html/img93.png differ
diff --git a/docs/html/img94.png b/docs/html/img94.png
index 809750546..4a2647496 100644
Binary files a/docs/html/img94.png and b/docs/html/img94.png differ
diff --git a/docs/html/img95.png b/docs/html/img95.png
index 4ffe59497..5a5b952c1 100644
Binary files a/docs/html/img95.png and b/docs/html/img95.png differ
diff --git a/docs/html/img96.png b/docs/html/img96.png
index f71e274b6..c79235f5a 100644
Binary files a/docs/html/img96.png and b/docs/html/img96.png differ
diff --git a/docs/html/img97.png b/docs/html/img97.png
index dc005ccf7..ac788493f 100644
Binary files a/docs/html/img97.png and b/docs/html/img97.png differ
diff --git a/docs/html/img98.png b/docs/html/img98.png
index 71d5daf69..894602207 100644
Binary files a/docs/html/img98.png and b/docs/html/img98.png differ
diff --git a/docs/html/img99.png b/docs/html/img99.png
index 99bf41640..781edc194 100644
Binary files a/docs/html/img99.png and b/docs/html/img99.png differ
diff --git a/docs/html/index.html b/docs/html/index.html
index f2f604f84..21e6f6b15 100644
--- a/docs/html/index.html
+++ b/docs/html/index.html
@@ -23,18 +23,18 @@ original version by:  Nikos Drakos, CBLU, University of Leeds
 
 
 
-
 next 
 up 
 previous 
-
 contents  
 
- Next: Next: Contents -   Contents

@@ -65,285 +65,289 @@ May 15th, 2010
    -
  • Contents
  • Introduction + HREF="node1.html">Contents
  • Introduction +
  • General overview
    -
  • Data Structures
    -
  • Computational routines -
      -
    • psb_geaxpby -- General Dense Matrix Sum -
    • psb_gedot -- Dot Product
    • psb_gedots -- Generalized Dot Product + HREF="node27.html">Computational routines + -
      + HREF="node36.html">psb_genrm2s -- Generalized 2-Norm of Vector
    • Communication routines - +
    • psb_gather -- Gather Global Dense Matrix + HREF="node40.html">Communication routines + -
      + HREF="node41.html">psb_halo -- Halo Data Communication
    • Data management routines - +
    • psb_cdasb -- Communication descriptor assembly routine + HREF="node45.html">Data management routines + -
      + HREF="node69.html">psb_get_overlap -- Extract list of overlap elements
    • Parallel environment routines -
      -
    • Error handling +
    • Parallel environment routines +
    • psb_set_errverbosity -- Sets the verbosity of error - messages. + HREF="node90.html">Error handling +
      -
    • Utilities -
        -
      • hb_read -- Read a sparse matrix from a file in the - Harwell-Boeing format -
      • hb_write -- Write a sparse matrix to a file - in the Harwell-Boeing format
      • mm_mat_read -- Read a sparse matrix from a - file in the MatrixMarket format + HREF="node95.html">Utilities +
        -
      • Preconditioner routines -

        diff --git a/docs/html/node1.html b/docs/html/node1.html index ab163ca07..a09708ac4 100644 --- a/docs/html/node1.html +++ b/docs/html/node1.html @@ -26,21 +26,21 @@ original version by: Nikos Drakos, CBLU, University of Leeds - next - up - previous
        - Next: Next: Introduction - Up: Up: userhtml - Previous: Previous: userhtml

        @@ -53,52 +53,54 @@ Contents

        diff --git a/docs/html/node10.html b/docs/html/node10.html index d77cc6675..8d059bd0e 100644 --- a/docs/html/node10.html +++ b/docs/html/node10.html @@ -25,26 +25,26 @@ original version by: Nikos Drakos, CBLU, University of Leeds - next - up - previous - contents
        - Next: Next: Sparse Matrix data structure - Up: Up: Descriptor data structure - Previous: Previous: Descriptor data structure -   Contents

        diff --git a/docs/html/node100.html b/docs/html/node100.html index 433c78c3d..47c3792cb 100644 --- a/docs/html/node100.html +++ b/docs/html/node100.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_precinit -- Initialize a preconditioner - +mm_mat_write -- Write a sparse matrix to a file in the MatrixMarket format + @@ -18,120 +18,97 @@ original version by: Nikos Drakos, CBLU, University of Leeds - - + - next - + up - previous - contents
        - Next: psb_precbld Builds - Up: Preconditioner routines - Previous: Preconditioner routines -   Next: Preconditioner routines + Up: Utilities + Previous: mm_vet_read Read +   Contents

        -

        -psb_precinit -- Initialize a preconditioner +

        +mm_mat_write -- Write a sparse matrix to a + file in the MatrixMarket format

        -

        -call psb_precinit(prec, ptype, info)
        +call mm_mat_write(a, mtitle, iret, iunit, filename)
         
        - -

        Type:
        Asynchronous.
        -
        On Entry
        +
        On Entry
        -
        ptype
        -
        the type of preconditioner. -Scope: global +
        a
        +
        the sparse matrix to be written.
        -Type: required +Type:required.
        -Intent: in. -
        -Specified as: a character string, see usage notes. +Specified as: a structured data of type spdatapsb_spmat_type.
        -
        On Exit
        -

        +

        mtitle
        +
        Matrix title. +
        +Type: required +
        +A charachter variable holding a descriptive title for the matrix to be + written to file.
        -
        prec
        -
        Scope: local +
        filename
        +
        The name of the file to be written to.
        -Type: required +Type:optional.
        -Intent: inout. -
        -Specified as: a preconditioner data structure precdatapsb_prec_type. +Specified as: a character variable containing a valid file name, or +-, in which case the default output unit 6 (i.e. standard output +in Unix jargon) is used. Default: -.
        -
        info
        -
        Scope: global +
        iunit
        +
        The Fortran file unit number.
        -Type: required +Type:optional.
        -Intent: out. -
        -Error code: if no error, 0 is returned. +Specified as: an integer value. Only meaningful if filename is not -.
        -Notes -Legal inputs to this subroutine are interpreted depending on the -$ptype$ string as follows3: + +

        -
        NONE
        -
        No preconditioning, i.e. the preconditioner is just a copy - operator. +
        On Return
        +
        -
        DIAG
        -
        Diagonal scaling; each entry of the input vector is - multiplied by the reciprocal of the sum of the absolute values of - the coefficients in the corresponding row of matrix $A$; -
        -
        BJAC
        -
        Precondition by a factorization of the - block-diagonal of matrix $A$, where block boundaries are determined - by the data allocation boundaries for each process; requires no - communication. Only the incomplete factorization $ILU(0)$ is - currently implemented. +
        iret
        +
        Error code. +
        +Type: required +
        +An integer value; 0 means no error has been detected.
        diff --git a/docs/html/node101.html b/docs/html/node101.html index f32730cd5..cec258081 100644 --- a/docs/html/node101.html +++ b/docs/html/node101.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_precbld -- Builds a preconditioner - +Preconditioner routines + @@ -18,119 +18,75 @@ original version by: Nikos Drakos, CBLU, University of Leeds - - - + + + - next - + up - previous - contents
        - Next: psb_precaply Preconditioner - Up: Preconditioner routines - Previous: psb_precinit Initialize -   Next: psb_precinit Initialize + Up: userhtml + Previous: mm_mat_write Write +   Contents

        -

        -psb_precbld -- Builds a preconditioner -

        +

        + +
        +Preconditioner routines +

        -

        -call psb_precbld(a, desc_a, prec, info)
        -
        +The base PSBLAS library contains the implementation of two simple +preconditioning techniques: + +
          +
        • Diagonal Scaling +
        • +
        • Block Jacobi with ILU(0) factorization +
        • +
        +The supporting data type and subroutine interfaces are defined in the +module psb_prec_mod.

        -

        -
        Type:
        -
        Synchronous. -
        -
        On Entry
        -
        -
        -
        a
        -
        the system sparse matrix. -Scope: local -
        -Type: required -
        -Intent: in, target. -
        -Specified as: a sparse matrix data structure spdatapsb_spmat_type. -
        -
        prec
        -
        the preconditioner. -
        -Scope: local -
        -Type: required -
        -Intent: inout. -
        -Specified as: an already initialized precondtioner data structure precdatapsb_prec_type -
        -
        desc_a
        -
        the problem communication descriptor. -Scope: local -
        -Type: required -
        -Intent: in, target. -
        -Specified as: a communication descriptor data structure descdatapsb_desc_type. -
        -
        +

        + +Subsections -

        -

        -
        On Return
        -
        -
        -
        prec
        -
        the preconditioner. -
        -Scope: local -
        -Type: required -
        -Intent: inout. -
        -Specified as: a precondtioner data structure precdatapsb_prec_type -
        -
        info
        -
        Error code. -
        -Scope: local -
        -Type: required -
        -Intent: out. -
        -An integer value; 0 means no error has been detected. -
        -
        - -

        +

        +

        diff --git a/docs/html/node102.html b/docs/html/node102.html index a562ec8e0..1acb83cb6 100644 --- a/docs/html/node102.html +++ b/docs/html/node102.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_precaply -- Preconditioner application routine - +psb_precinit -- Initialize a preconditioner + @@ -20,131 +20,118 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_precdescr Prints - Up: Preconditioner routines - Previous: psb_precbld Builds -   Next: psb_precbld Builds + Up: Preconditioner routines + Previous: Preconditioner routines +   Contents

        -

        -psb_precaply -- Preconditioner application routine +

        +psb_precinit -- Initialize a preconditioner

        -call psb_precaply(prec,x,y,desc_a,info,trans,work)
        -call psb_precaply(prec,x,desc_a,info,trans)
        +call psb_precinit(prec, ptype, info)
         

        Type:
        -
        Synchronous. +
        Asynchronous.
        On Entry
        -
        prec
        -
        the preconditioner. -Scope: local +
        ptype
        +
        the type of preconditioner. +Scope: global
        Type: required
        Intent: in.
        +Specified as: a character string, see usage notes. +
        +
        On Exit
        +

        +

        +
        prec
        +
        Scope: local +
        +Type: required +
        +Intent: inout. +
        Specified as: a preconditioner data structure precdatapsb_prec_type.
        -
        x
        -
        the source vector. -Scope: local -
        -Type: required -
        -Intent: inout. -
        -Specified as: a double precision array. -
        -
        desc_a
        -
        the problem communication descriptor. -Scope: local -
        -Type: required -
        -Intent: in. -
        -Specified as: a communication data structure descdatapsb_desc_type. -
        -
        trans
        -
        Scope: -
        -Type: optional -
        -Intent: in. -
        -Specified as: a character. -
        -
        work
        -
        an optional work space -Scope: local -
        -Type: optional -
        -Intent: inout. -
        -Specified as: a double precision array. -
        -
        - -

        -

        -
        On Return
        -
        -
        -
        y
        -
        the destination vector. -Scope: local -
        -Type: required -
        -Intent: inout. -
        -Specified as: a double precision array. -
        info
        -
        Error code. +
        Scope: global
        -Scope: local -
        -Type: required +Type: required
        Intent: out.
        -An integer value; 0 means no error has been detected. +Error code: if no error, 0 is returned. +
        +
        +Notes +Legal inputs to this subroutine are interpreted depending on the +$ptype$ string as follows3: +
        +
        NONE
        +
        No preconditioning, i.e. the preconditioner is just a copy + operator. +
        +
        DIAG
        +
        Diagonal scaling; each entry of the input vector is + multiplied by the reciprocal of the sum of the absolute values of + the coefficients in the corresponding row of matrix $A$; +
        +
        BJAC
        +
        Precondition by a factorization of the + block-diagonal of matrix $A$, where block boundaries are determined + by the data allocation boundaries for each process; requires no + communication. Only the incomplete factorization $ILU(0)$ is + currently implemented.
        diff --git a/docs/html/node103.html b/docs/html/node103.html index af95e6ca6..a14e01963 100644 --- a/docs/html/node103.html +++ b/docs/html/node103.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_precdescr -- Prints a description of current preconditioner - +psb_precbld -- Builds a preconditioner + @@ -18,76 +18,115 @@ original version by: Nikos Drakos, CBLU, University of Leeds + - + - next - + up - previous - contents
        - Next: Iterative Methods - Up: Preconditioner routines - Previous: psb_precaply Preconditioner -   Next: psb_precaply Preconditioner + Up: Preconditioner routines + Previous: psb_precinit Initialize +   Contents

        -

        -psb_precdescr -- Prints a description of current - preconditioner +

        +psb_precbld -- Builds a preconditioner

        -call psb_precdescr(prec)
        -call psb_precdescr(prec, iout)
        +call psb_precbld(a, desc_a, prec, info)
         

        Type:
        -
        Asynchronous. +
        Synchronous.
        On Entry
        -
        prec
        -
        the preconditioner. +
        a
        +
        the system sparse matrix. Scope: local
        Type: required
        -Intent: in. +Intent: in, target.
        -Specified as: a preconditioner data structure precdatapsb_prec_type. +Specified as: a sparse matrix data structure spdatapsb_spmat_type.
        -
        iout
        -
        output unit. +
        prec
        +
        the preconditioner. +
        Scope: local
        -Type: optiona +Type: required
        -Intent: in. +Intent: inout.
        -Specified as: an integer number. +Specified as: an already initialized precondtioner data structure precdatapsb_prec_type +
        +
        desc_a
        +
        the problem communication descriptor. +Scope: local +
        +Type: required +
        +Intent: in, target. +
        +Specified as: a communication descriptor data structure descdatapsb_desc_type. +
        +
        + +

        +

        +
        On Return
        +
        +
        +
        prec
        +
        the preconditioner. +
        +Scope: local +
        +Type: required +
        +Intent: inout. +
        +Specified as: a precondtioner data structure precdatapsb_prec_type +
        +
        info
        +
        Error code. +
        +Scope: local +
        +Type: required +
        +Intent: out. +
        +An integer value; 0 means no error has been detected.
        diff --git a/docs/html/node104.html b/docs/html/node104.html index 5c6bb8459..62561612a 100644 --- a/docs/html/node104.html +++ b/docs/html/node104.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -Iterative Methods - +psb_precaply -- Preconditioner application routine + @@ -18,62 +18,138 @@ original version by: Nikos Drakos, CBLU, University of Leeds - - - + + + - next - + up - previous - contents
        - Next: psb_krylov Krylov - Up: userhtml - Previous: psb_precdescr Prints -   Next: psb_precdescr Prints + Up: Preconditioner routines + Previous: psb_precbld Builds +   Contents

        -

        - +

        +psb_precaply -- Preconditioner application routine +

        + +

        +

        +call psb_precaply(prec,x,y,desc_a,info,trans,work)
        +call psb_precaply(prec,x,desc_a,info,trans)
        +
        + +

        +

        +
        Type:
        +
        Synchronous. +
        +
        On Entry
        +
        +
        +
        prec
        +
        the preconditioner. +Scope: local
        -Iterative Methods - +Type: required +
        +Intent: in. +
        +Specified as: a preconditioner data structure precdatapsb_prec_type. +
        +
        x
        +
        the source vector. +Scope: local +
        +Type: required +
        +Intent: inout. +
        +Specified as: a double precision array. +
        +
        desc_a
        +
        the problem communication descriptor. +Scope: local +
        +Type: required +
        +Intent: in. +
        +Specified as: a communication data structure descdatapsb_desc_type. +
        +
        trans
        +
        Scope: +
        +Type: optional +
        +Intent: in. +
        +Specified as: a character. +
        +
        work
        +
        an optional work space +Scope: local +
        +Type: optional +
        +Intent: inout. +
        +Specified as: a double precision array. +
        +

        -In this chapter we provide routines for preconditioners and iterative -methods. The interfaces for Krylov subspace methods are available in -the module psb_krylov_mod. +

        +
        On Return
        +
        +
        +
        y
        +
        the destination vector. +Scope: local +
        +Type: required +
        +Intent: inout. +
        +Specified as: a double precision array. +
        +
        info
        +
        Error code. +
        +Scope: local +
        +Type: required +
        +Intent: out. +
        +An integer value; 0 means no error has been detected. +
        +



        - -Subsections - - - -

        diff --git a/docs/html/node105.html b/docs/html/node105.html index 09a0237a7..763bda29e 100644 --- a/docs/html/node105.html +++ b/docs/html/node105.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_krylov -- Krylov Methods Driver Routine - +psb_precdescr -- Prints a description of current preconditioner + @@ -19,369 +19,80 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: Bibliography - Up: Iterative Methods - Previous: Iterative Methods -   Next: Iterative Methods + Up: Preconditioner routines + Previous: psb_precaply Preconditioner +   Contents

        -

        -
        -psb_krylov -- Krylov Methods Driver - Routine +

        +psb_precdescr -- Prints a description of current + preconditioner

        -

        -This subroutine is a driver that provides a general interface for all -the Krylov-Subspace family methods implemented in PSBLAS version 2. - -

        -The stopping criterion is the normwise backward error, in the infinity -norm, i.e. the iteration is stopped when -

        -
        - - -\begin{displaymath}err = \frac{\Vert r_i\Vert}{(\Vert A\Vert\Vert x_i\Vert+\Vert b\Vert)} < eps \end{displaymath} -
        -
        -

        -or the 2-norm residual reduction -

        -
        - - -\begin{displaymath}err = \frac{\Vert r_i\Vert}{\Vert b\Vert _2} < eps \end{displaymath} -
        -
        -

        -according to the value passed through the istop argument (see -later). In the above formulae, $x_i$ is the tentative solution and -$r_i=b-Ax_i$ the corresponding residual at the $i$-th iteration. -

        -call psb_krylov(method,a,prec,b,x,eps,desc_a,info,&
        -     & itmax,iter,err,itrace,irst,istop,cond)
        +call psb_precdescr(prec)
        +call psb_precdescr(prec, iout)
         

        Type:
        -
        Synchronous. +
        Asynchronous.
        On Entry
        -
        method
        -
        a string that defines the iterative method to be - used. Supported values are: -
        -
        CG:
        -
        the Conjugate Gradient method; - -
        -
        CGS:
        -
        the Conjugate Gradient Stabilized method; - -

        -

        -
        BICG:
        -
        the Bi-Conjugate Gradient method; - -
        -
        BICGSTAB:
        -
        the Bi-Conjugate Gradient Stabilized method; - -
        -
        BICGSTABL:
        -
        the Bi-Conjugate Gradient Stabilized method with restarting; - -
        -
        RGMRES:
        -
        the Generalized Minimal Residual method with restarting. - -
        -
        -
        -
        a
        -
        the local portion of global sparse matrix -$A$. -
        -Scope: local -
        -Type: required -
        -Intent: in. -
        -Specified as: a structured data of type spdatapsb_spmat_type. -
        prec
        -
        The data structure containing the preconditioner. -
        +
        the preconditioner. Scope: local
        Type: required
        Intent: in.
        -Specified as: a structured data of type precdatapsb_prec_type. +Specified as: a preconditioner data structure precdatapsb_prec_type.
        -
        b
        -
        The RHS vector. -
        +
        iout
        +
        output unit. Scope: local
        -Type: required +Type: optiona
        Intent: in.
        -Specified as: a rank one array. -
        -
        x
        -
        The initial guess. -
        -Scope: local -
        -Type: required -
        -Intent: inout. -
        -Specified as: a rank one array. -
        -
        eps
        -
        The stopping tolerance. -
        -Scope: global -
        -Type: required -
        -Intent: in. -
        -Specified as: a real number. -
        -
        desc_a
        -
        contains data structures for communications. -
        -Scope: local -
        -Type: required -
        -Intent: in. -
        -Specified as: a structured data of type descdatapsb_desc_type. -
        -
        itmax
        -
        The maximum number of iterations to perform. -
        -Scope: global -
        -Type: optional -
        -Intent: in. -
        -Default: $itmax = 1000$. -
        -Specified as: an integer variable $itmax \ge 1$. -
        -
        itrace
        -
        If $>0$ print out an informational message about - convergence every $itrace$ iterations. -
        -Scope: global -
        -Type: optional -
        -Intent: in. -
        -
        irst
        -
        An integer specifying the restart parameter. -
        -Scope: global -
        -Type: optional. -
        -Intent: in. -
        -Values: $irst>0$. This is employed for the BiCGSTABL or RGMRES -methods, otherwise it is ignored. - -

        -

        -
        istop
        -
        An integer specifying the stopping criterion. -
        -Scope: global -
        -Type: optional. -
        -Intent: in. -
        -Values: 1: use the normwise backward error, 2: use the scaled 2-norm -of the residual. Default: 2. -
        -
        On Return
        -
        -
        -
        x
        -
        The computed solution. -
        -Scope: local -
        -Type: required -
        -Intent: inout. -
        -Specified as: a rank one array. -
        -
        iter
        -
        The number of iterations performed. -
        -Scope: global -
        -Type: optional -
        -Intent: out. -
        -Returned as: an integer variable. -
        -
        err
        -
        The convergence estimate on exit. -
        -Scope: global -
        -Type: optional -
        -Intent: out. -
        -Returned as: a real number. -
        -
        cond
        -
        An estimate of the condition number of matrix $A$; only - available with the $CG$ method. -
        -Scope: global -
        -Type: optional -
        -Intent: out. -
        -Returned as: a real number. -
        -
        info
        -
        Error code. -
        -Scope: local -
        -Type: required -
        -Intent: out. -
        -An integer value; 0 means no error has been detected. +Specified as: an integer number.

        - -

        - -

        -


        - - -next - -up - -previous - -contents -
        - Next: Bibliography - Up: Iterative Methods - Previous: Iterative Methods -   Contents - +

        diff --git a/docs/html/node106.html b/docs/html/node106.html index 154ca5866..0904e909d 100644 --- a/docs/html/node106.html +++ b/docs/html/node106.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -Bibliography - +Iterative Methods + @@ -18,140 +18,61 @@ original version by: Nikos Drakos, CBLU, University of Leeds - - + + - next - up - previous - contents
        - Next: About this document ... - Up: Next: psb_krylov Krylov + Up: userhtml - Previous: psb_krylov Krylov -   Previous: psb_precdescr Prints +   Contents -

        +
        +
        - -

        -Bibliography -

        -

        -

        1 -
        -G. Bella, S. Filippone, A. De Maio and M. Testa, -A Simulation Model for Forest Fires, -in J. Dongarra, K. Madsen, J. Wasniewski, editors, -Proceedings of PARA 04 Workshop on State of the Art -in Scientific Computing, pp. 546-553, Lecture Notes in Computer Science, -Springer, 2005. -

        2 -
        A. Buttari, D. di Serafino, P. D'Ambra, S. Filippone,
        -2LEV-D2P4: a package of high-performance preconditioners,
        -Applicable Algebra in Engineering, Communications and Computing, -Volume 18, Number 3, May, 2007, pp. 223-239 -

        3 -
        P. D'Ambra, S. Filippone, D. Di Serafino
        -On the Development of PSBLAS-based Parallel Two-level Schwarz Preconditioners + +

        +
        -Applied Numerical Mathematics, Elsevier Science, -Volume 57, Issues 11-12, November-December 2007, Pages 1181-1196. +Iterative Methods +

        -

        4 -
        - Dongarra, J. J., DuCroz, J., Hammarling, S. and Hanson, R., -An Extended Set of Fortran Basic Linear Algebra Subprograms, -ACM Trans. Math. Softw. vol. 14, 1-17, 1988. -

        5 -
        - Dongarra, J., DuCroz, J., Hammarling, S. and Duff, I., -A Set of level 3 Basic Linear Algebra Subprograms, -ACM Trans. Math. Softw. vol. 16, 1-17, 1990. -

        6 -
        -J. J. Dongarra and R. C. Whaley, -A User's Guide to the BLACS v. 1.1, -Lapack Working Note 94, Tech. Rep. UT-CS-95-281, University of -Tennessee, March 1995 (updated May 1997). -

        7 -
        -I. Duff, M. Marrone, G. Radicati and C. Vittoli, -Level 3 Basic Linear Algebra Subprograms for Sparse Matrices: -a User Level Interface, -ACM Transactions on Mathematical Software, 23(3), pp. 379-401, 1997. -

        8 -
        -I. Duff, M. Heroux and R. Pozo, -An Overview of the Sparse Basic Linear -Algebra Subprograms: the New Standard from the BLAS Technical Forum, -ACM Transactions on Mathematical Software, 28(2), pp. 239-267, 2002. -

        9 -
        -S. Filippone and M. Colajanni, -PSBLAS: A Library for Parallel Linear Algebra -Computation on Sparse Matrices, -
        -ACM Transactions on Mathematical Software, 26(4), pp. 527-550, 2000. -

        10 -
        -S. Filippone, P. D'Ambra, M. Colajanni, -Using a Parallel Library of Sparse Linear Algebra in a Fluid Dynamics -Applications Code on Linux Clusters, -in G. Joubert, A. Murli, F. Peters, M. Vanneschi, editors, -Parallel Computing - Advances & Current Issues, -pp. 441-448, Imperial College Press, 2002. -

        11 -
        -Karypis, G. and Kumar, V., -METIS: Unstructured Graph Partitioning and Sparse Matrix - Ordering System. -Minneapolis, MN 55455: University of Minnesota, Department of - Computer Science, 1995. -Internet Address: http://www.cs.umn.edu/~karypis. -

        12 -
        -Lawson, C., Hanson, R., Kincaid, D. and Krogh, F., - Basic Linear Algebra Subprograms for Fortran usage, -ACM Trans. Math. Softw. vol. 5, 38-329, 1979. +In this chapter we provide routines for preconditioners and iterative +methods. The interfaces for Krylov subspace methods are available in +the module psb_krylov_mod.

        -

        13 -
        -Machiels, L. and Deville, M. -Fortran 90: An entry to object-oriented programming for the solution - of partial differential equations. -ACM Trans. Math. Softw. vol. 23, 32-49. -

        14 -
        -Metcalf, M., Reid, J. and Cohen, M. -Fortran 95/2003 explained. -Oxford University Press, 2004. -

        15 -
        -M. Snir, S. Otto, S. Huss-Lederman, D. Walker and J. Dongarra, -MPI: The Complete Reference. Volume 1 - The MPI Core, second edition, -MIT Press, 1998. -
        +

        + +Subsections -

        +

        +

        diff --git a/docs/html/node107.html b/docs/html/node107.html index dd0765119..bf54a8f32 100644 --- a/docs/html/node107.html +++ b/docs/html/node107.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -About this document ... - +psb_krylov -- Krylov Methods Driver Routine + @@ -19,52 +19,369 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + + -next - + +next + up - previous - contents
        - Up: userhtml - Previous: Bibliography -   Next: Bibliography + Up: Iterative Methods + Previous: Iterative Methods +   Contents

        -

        -About this document ... -

        -

        -This document was generated using the -LaTeX2HTML translator Version 2008 (1.71) -

        -Copyright © 1993, 1994, 1995, 1996, -Nikos Drakos, -Computer Based Learning Unit, University of Leeds. +


        -Copyright © 1997, 1998, 1999, -Ross Moore, -Mathematics Department, Macquarie University, Sydney. +psb_krylov -- Krylov Methods Driver + Routine +

        +

        -The command line arguments were:
        - latex2html -local_icons -noaddress -dir ../../html userhtml.tex +This subroutine is a driver that provides a general interface for all +the Krylov-Subspace family methods implemented in PSBLAS version 2. +

        -The translation was initiated by Salvatore Filippone on 2011-03-25 -


        +The stopping criterion is the normwise backward error, in the infinity +norm, i.e. the iteration is stopped when +

        +
        + + +\begin{displaymath}err = \frac{\Vert r_i\Vert}{(\Vert A\Vert\Vert x_i\Vert+\Vert b\Vert)} < eps \end{displaymath} +
        +
        +

        +or the 2-norm residual reduction +

        +
        + + +\begin{displaymath}err = \frac{\Vert r_i\Vert}{\Vert b\Vert _2} < eps \end{displaymath} +
        +
        +

        +according to the value passed through the istop argument (see +later). In the above formulae, $x_i$ is the tentative solution and +$r_i=b-Ax_i$ the corresponding residual at the $i$-th iteration. + +

        +

        +call psb_krylov(method,a,prec,b,x,eps,desc_a,info,&
        +     & itmax,iter,err,itrace,irst,istop,cond)
        +
        + +

        +

        +
        Type:
        +
        Synchronous. +
        +
        On Entry
        +
        +
        +
        method
        +
        a string that defines the iterative method to be + used. Supported values are: +
        +
        CG:
        +
        the Conjugate Gradient method; + +
        +
        CGS:
        +
        the Conjugate Gradient Stabilized method; + +

        +

        +
        BICG:
        +
        the Bi-Conjugate Gradient method; + +
        +
        BICGSTAB:
        +
        the Bi-Conjugate Gradient Stabilized method; + +
        +
        BICGSTABL:
        +
        the Bi-Conjugate Gradient Stabilized method with restarting; + +
        +
        RGMRES:
        +
        the Generalized Minimal Residual method with restarting. + +
        +
        +
        +
        a
        +
        the local portion of global sparse matrix +$A$. +
        +Scope: local +
        +Type: required +
        +Intent: in. +
        +Specified as: a structured data of type spdatapsb_spmat_type. +
        +
        prec
        +
        The data structure containing the preconditioner. +
        +Scope: local +
        +Type: required +
        +Intent: in. +
        +Specified as: a structured data of type precdatapsb_prec_type. +
        +
        b
        +
        The RHS vector. +
        +Scope: local +
        +Type: required +
        +Intent: in. +
        +Specified as: a rank one array. +
        +
        x
        +
        The initial guess. +
        +Scope: local +
        +Type: required +
        +Intent: inout. +
        +Specified as: a rank one array. +
        +
        eps
        +
        The stopping tolerance. +
        +Scope: global +
        +Type: required +
        +Intent: in. +
        +Specified as: a real number. +
        +
        desc_a
        +
        contains data structures for communications. +
        +Scope: local +
        +Type: required +
        +Intent: in. +
        +Specified as: a structured data of type descdatapsb_desc_type. +
        +
        itmax
        +
        The maximum number of iterations to perform. +
        +Scope: global +
        +Type: optional +
        +Intent: in. +
        +Default: $itmax = 1000$. +
        +Specified as: an integer variable $itmax \ge 1$. +
        +
        itrace
        +
        If $>0$ print out an informational message about + convergence every $itrace$ iterations. +
        +Scope: global +
        +Type: optional +
        +Intent: in. +
        +
        irst
        +
        An integer specifying the restart parameter. +
        +Scope: global +
        +Type: optional. +
        +Intent: in. +
        +Values: $irst>0$. This is employed for the BiCGSTABL or RGMRES +methods, otherwise it is ignored. + +

        +

        +
        istop
        +
        An integer specifying the stopping criterion. +
        +Scope: global +
        +Type: optional. +
        +Intent: in. +
        +Values: 1: use the normwise backward error, 2: use the scaled 2-norm +of the residual. Default: 2. +
        +
        On Return
        +
        +
        +
        x
        +
        The computed solution. +
        +Scope: local +
        +Type: required +
        +Intent: inout. +
        +Specified as: a rank one array. +
        +
        iter
        +
        The number of iterations performed. +
        +Scope: global +
        +Type: optional +
        +Intent: out. +
        +Returned as: an integer variable. +
        +
        err
        +
        The convergence estimate on exit. +
        +Scope: global +
        +Type: optional +
        +Intent: out. +
        +Returned as: a real number. +
        +
        cond
        +
        An estimate of the condition number of matrix $A$; only + available with the $CG$ method. +
        +Scope: global +
        +Type: optional +
        +Intent: out. +
        +Returned as: a real number. +
        +
        info
        +
        Error code. +
        +Scope: local +
        +Type: required +
        +Intent: out. +
        +An integer value; 0 means no error has been detected. +
        +
        + +

        + +

        + +

        +


        + + +next + +up + +previous + +contents +
        + Next: Bibliography + Up: Iterative Methods + Previous: Iterative Methods +   Contents + diff --git a/docs/html/node108.html b/docs/html/node108.html index 9843ce773..45532ac66 100644 --- a/docs/html/node108.html +++ b/docs/html/node108.html @@ -1,135 +1,154 @@ - -psb_precbld -- Builds a preconditioner - +Bibliography + - + - + - -next - + -up - + -previous - + -contents +contents
        - Next: psb_precaply Preconditioner - Up: Next: About this document ... + Up: userhtml - Previous: psb_precinit Initialize -   Previous: psb_krylov Krylov +   Contents -
        -
        +

        - -

        -psb_precbld -- Builds a preconditioner -

        - + +

        +Bibliography +

        -ifstarssyntaxsyntaxcall psb_precblda, desc_a, prec, info - -

        -

        -
        Type:
        -
        Synchronous. -
        -
        On Entry
        +

        1
        -
        -
        a
        -
        the system sparse matrix. -Scope: local +G. Bella, S. Filippone, A. De Maio and M. Testa, +A Simulation Model for Forest Fires, +in J. Dongarra, K. Madsen, J. Wasniewski, editors, +Proceedings of PARA 04 Workshop on State of the Art +in Scientific Computing, pp. 546-553, Lecture Notes in Computer Science, +Springer, 2005. +

        2 +
        A. Buttari, D. di Serafino, P. D'Ambra, S. Filippone,
        +2LEV-D2P4: a package of high-performance preconditioners,
        +Applicable Algebra in Engineering, Communications and Computing, +Volume 18, Number 3, May, 2007, pp. 223-239 +

        3 +
        P. D'Ambra, S. Filippone, D. Di Serafino
        +On the Development of PSBLAS-based Parallel Two-level Schwarz Preconditioners
        -Type: required -
        -Intent: in, target. -
        -Specified as: a sparse matrix data structure spdatapsb_spmat_type. -
        -
        prec
        -
        the preconditioner. -
        -Scope: local -
        -Type: required -
        -Intent: inout. -
        -Specified as: an already initialized precondtioner data structure precdatapsb_prec_type -
        -
        desc_a
        -
        the problem communication descriptor. -Scope: local -
        -Type: required -
        -Intent: in, target. -
        -Specified as: a communication descriptor data structure descdatapsb_desc_type. -
        -
        +Applied Numerical Mathematics, Elsevier Science, +Volume 57, Issues 11-12, November-December 2007, Pages 1181-1196.

        -

        -
        On Return
        +

        4
        -
        -
        prec
        -
        the preconditioner. + Dongarra, J. J., DuCroz, J., Hammarling, S. and Hanson, R., +An Extended Set of Fortran Basic Linear Algebra Subprograms, +ACM Trans. Math. Softw. vol. 14, 1-17, 1988. +

        5 +
        + Dongarra, J., DuCroz, J., Hammarling, S. and Duff, I., +A Set of level 3 Basic Linear Algebra Subprograms, +ACM Trans. Math. Softw. vol. 16, 1-17, 1990. +

        6 +
        +J. J. Dongarra and R. C. Whaley, +A User's Guide to the BLACS v. 1.1, +Lapack Working Note 94, Tech. Rep. UT-CS-95-281, University of +Tennessee, March 1995 (updated May 1997). +

        7 +
        +I. Duff, M. Marrone, G. Radicati and C. Vittoli, +Level 3 Basic Linear Algebra Subprograms for Sparse Matrices: +a User Level Interface, +ACM Transactions on Mathematical Software, 23(3), pp. 379-401, 1997. +

        8 +
        +I. Duff, M. Heroux and R. Pozo, +An Overview of the Sparse Basic Linear +Algebra Subprograms: the New Standard from the BLAS Technical Forum, +ACM Transactions on Mathematical Software, 28(2), pp. 239-267, 2002. +

        9 +
        +S. Filippone and M. Colajanni, +PSBLAS: A Library for Parallel Linear Algebra +Computation on Sparse Matrices,
        -Scope: local -
        -Type: required -
        -Intent: inout. -
        -Specified as: a precondtioner data structure precdatapsb_prec_type -
        -
        info
        -
        Error code. -
        -Scope: local -
        -Type: required -
        -Intent: out. -
        -An integer value; 0 means no error has been detected. -
        +ACM Transactions on Mathematical Software, 26(4), pp. 527-550, 2000. +

        10 +
        +S. Filippone, P. D'Ambra, M. Colajanni, +Using a Parallel Library of Sparse Linear Algebra in a Fluid Dynamics +Applications Code on Linux Clusters, +in G. Joubert, A. Murli, F. Peters, M. Vanneschi, editors, +Parallel Computing - Advances & Current Issues, +pp. 441-448, Imperial College Press, 2002. +

        11 +
        +Karypis, G. and Kumar, V., +METIS: Unstructured Graph Partitioning and Sparse Matrix + Ordering System. +Minneapolis, MN 55455: University of Minnesota, Department of + Computer Science, 1995. +Internet Address: http://www.cs.umn.edu/~karypis. +

        12 +
        +Lawson, C., Hanson, R., Kincaid, D. and Krogh, F., + Basic Linear Algebra Subprograms for Fortran usage, +ACM Trans. Math. Softw. vol. 5, 38-329, 1979. + +

        +

        13 +
        +Machiels, L. and Deville, M. +Fortran 90: An entry to object-oriented programming for the solution + of partial differential equations. +ACM Trans. Math. Softw. vol. 23, 32-49. +

        14 +
        +Metcalf, M., Reid, J. and Cohen, M. +Fortran 95/2003 explained. +Oxford University Press, 2004. +

        15 +
        +M. Snir, S. Otto, S. Huss-Lederman, D. Walker and J. Dongarra, +MPI: The Complete Reference. Volume 1 - The MPI Core, second edition, +MIT Press, 1998.

        diff --git a/docs/html/node109.html b/docs/html/node109.html index 8ef0c0fdc..d2736bced 100644 --- a/docs/html/node109.html +++ b/docs/html/node109.html @@ -1,156 +1,69 @@ - -psb_precaply -- Preconditioner application routine - +About this document ... + - + - - - -next - + -up - + -previous - + -contents +contents
        - Next: psb_precdescr Prints - Up: Up: userhtml - Previous: psb_precbld Builds -   Previous: Bibliography +   Contents

        -

        -psb_precaply -- Preconditioner application routine +

        +About this document ...

        - +

        +This document was generated using the +LaTeX2HTML translator Version 2008 (1.71)

        -ifstarssyntaxsyntaxcall psb_precaplyprec,x,y,desc_a,info,trans,work -ifstarssyntaxsyntax*call psb_precaplyprec,x,desc_a,info,trans - +Copyright © 1993, 1994, 1995, 1996, +Nikos Drakos, +Computer Based Learning Unit, University of Leeds. +
        +Copyright © 1997, 1998, 1999, +Ross Moore, +Mathematics Department, Macquarie University, Sydney.

        -

        -
        Type:
        -
        Synchronous. -
        -
        On Entry
        -
        -
        -
        prec
        -
        the preconditioner. -Scope: local -
        -Type: required -
        -Intent: in. -
        -Specified as: a preconditioner data structure precdatapsb_prec_type. -
        -
        x
        -
        the source vector. -Scope: local -
        -Type: required -
        -Intent: inout. -
        -Specified as: a double precision array. -
        -
        desc_a
        -
        the problem communication descriptor. -Scope: local -
        -Type: required -
        -Intent: in. -
        -Specified as: a communication data structure descdatapsb_desc_type. -
        -
        trans
        -
        Scope: -
        -Type: optional -
        -Intent: in. -
        -Specified as: a character. -
        -
        work
        -
        an optional work space -Scope: local -
        -Type: optional -
        -Intent: inout. -
        -Specified as: a double precision array. -
        -
        - -

        -

        -
        On Return
        -
        -
        -
        y
        -
        the destination vector. -Scope: local -
        -Type: required -
        -Intent: inout. -
        -Specified as: a double precision array. -
        -
        info
        -
        Error code. -
        -Scope: local -
        -Type: required -
        -Intent: out. -
        -An integer value; 0 means no error has been detected. -
        -
        - +The command line arguments were:
        + latex2html -local_icons -noaddress -dir ../../html userhtml.tex

        +The translation was initiated by Salvatore Filippone on 2011-10-13


        diff --git a/docs/html/node11.html b/docs/html/node11.html index 4c8bf984d..6a904f4cf 100644 --- a/docs/html/node11.html +++ b/docs/html/node11.html @@ -26,26 +26,26 @@ original version by: Nikos Drakos, CBLU, University of Leeds - next - up - previous - contents
        - Next: Next: Named Constants - Up: Up: Data Structures - Previous: Previous: Named Constants -   Contents

        @@ -125,11 +125,11 @@ Specified as: integer variable.
        The Fortran 95 interface for distributed sparse matrices containing double precision real entries is defined as shown in -figure 4. The definitions for single precision and +figure 5. The definitions for single precision and complex data are identical except for the real declaration and for the kind type parameter. -
        +
        Figure 4: The PSBLAS defined data type that @@ -142,7 +142,7 @@ for the kind type parameter. $\fbox{\TheSbox}$ --> \fbox{\TheSbox} @@ -171,7 +171,7 @@ contains the corresponding coefficient value, for all $ia2(1) \le j
 \le ia2(m+1)-1$. @@ -190,7 +190,7 @@ matrix; $1 \le j \le infoa(1)$ --> $1 \le j \le infoa(1)$, the coefficient, row index and column index are stored into apsk(j), ia1(j) and @@ -223,32 +223,32 @@ values: Subsections
        - next - up - previous - contents
        - Next: Next: Named Constants - Up: Up: Data Structures - Previous: Previous: Named Constants -   Contents diff --git a/docs/html/node12.html b/docs/html/node12.html index dccdb039f..5783c3b99 100644 --- a/docs/html/node12.html +++ b/docs/html/node12.html @@ -25,26 +25,26 @@ original version by: Nikos Drakos, CBLU, University of Leeds - next - up - previous - contents
        - Next: Preconditioner data structure - Up: Next: Dense Vector Data Structure + Up: Sparse Matrix data structure - Previous: Previous: Sparse Matrix data structure -   Contents

        diff --git a/docs/html/node13.html b/docs/html/node13.html index 39ec25d48..b9b789c14 100644 --- a/docs/html/node13.html +++ b/docs/html/node13.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -Preconditioner data structure - +Dense Vector Data Structure + @@ -18,7 +18,7 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + @@ -26,74 +26,231 @@ original version by: Nikos Drakos, CBLU, University of Leeds - next - up - previous - contents
        - Next: Data structure query routines - Up: Next: Named Constants + Up: Data Structures - Previous: Previous: Named Constants -   Contents

        - +
        -Preconditioner data structure +Dense Vector Data Structure

        -Our base library offers support for simple well known preconditioners -like Diagonal Scaling or Block Jacobi with incomplete -factorization ILU(0). +The vdatapsb_vect_type data structure +contains all information about local portion of the sparse matrix and +its storage mode. Most of these fields are set by the tools +routines when inserting a new sparse matrix; the user needs only +choose, if he/she so whishes, a specific matrix storage mode. +
        +
        aspk
        +
        Contains values of the local distributed sparse +matrix. +
        +Specified as: an allocatable array of rank one of type corresponding +to matrix entries type. +
        +
        ia1
        +
        Holds integer information on distributed sparse +matrix. Actual information will depend on data format used. +
        +Specified as: an allocatable integer array of rank one. +
        +
        ia2
        +
        Holds integer information on distributed sparse +matrix. Actual information will depend on data format used. +
        +Specified as: an allocatable integer array of rank one. +
        +
        infoa
        +
        On entry can hold auxiliary information on distributed sparse +matrix. Actual information will depend on data format used. +
        +Specified as: an integer array of length psb_ifasize_. +
        +
        fida
        +
        Defines the format of the distributed sparse matrix. +
        +Specified as: a string of length 5 +
        +
        descra
        +
        Describe the characteristic of the distributed sparse matrix. +
        +Specified as: array of character of length 9. +
        +
        pl
        +
        Specifies the local row permutation of distributed sparse +matrix. If pl(1) is equal to 0, then there isn't row permutation. +
        +Specified as: an allocatable integer array of dimension equal to number of local row (matrix_data[psb_n_row_]) +
        +
        pr
        +
        Specifies the local column permutation of distributed sparse +matrix. If PR(1) is equal to 0, then there isn't columnm permutation. +
        +Specified as: an allocatable integer array of dimension equal to number of +local row (matrix_data[psb_n_col_]) +
        +
        m
        +
        Number of rows; if row indices are stored explicitly, +as in Coordinate Storage, should be greater than or equal to the +maximum row index actually present in the sparse matrix. +Specified as: integer variable. +
        +
        k
        +
        Number of columns; if column indices are stored explicitly, +as in Coordinate Storage or Compressed Sparse Rows, should be greater +than or equal to the maximum column index actually present in the sparse matrix. +Specified as: integer variable. +
        +
        +The Fortran 95 interface for distributed sparse matrices containing +double precision real entries is defined as shown in +figure 5. The definitions for single precision and +complex data are identical except for the real declaration and +for the kind type parameter. -

        -A preconditioner is held in the precdata psb_prec_type data structure reported in -figure 5. The psb_prec_type -data type may contain a simple preconditioning matrix with the -associated communication descriptor.The values contained in -the iprcparm and rprcparm define tha type of -preconditioner along with all the parameters related to it; thus, -iprcparm and rprcparm define how the other records have -to be interpreted. This data structure is the basis of more complex -preconditioning strategies, which are the subject of further -research. - -

        +
        - + ALT="\fbox{\TheSbox}"> +
        Figure 5: -The PSBLAS defined data type that contains a preconditioner.

        - + The PSBLAS defined data type that + contains a sparse matrix. +

        - -
        \fbox{\TheSbox}
        -

        +The following two cases are among the most commonly used: +

        +
        fida=``CSR''
        +
        Compressed storage by rows. In this case the +following should hold: + +
          +
        1. ia2(i) contains the index of the first element of row +i; the last element of the sparse matrix is thus stored at +index $ia2(m+1)-1$. It should contain m+1 entries in +nondecreasing order (strictly increasing, if there are no empty rows). +
        2. +
        3. ia1(j) contains the column index and aspk(j) +contains the corresponding coefficient value, for all +$ia2(1) \le j
+\le ia2(m+1)-1$. +
        4. +
        +
        +
        fida=``COO''
        +
        Coordinate storage. In this case the following +should hold: + +
          +
        1. infoa(1) contains the number of nonzero elements in the +matrix; +
        2. +
        3. For all +$1 \le j \le infoa(1)$, the coefficient, row index and +column index are stored into apsk(j), ia1(j) and +ia2(j) respectively. +
        4. +
        +
        +
        +A sparse matrix has an associated state, which can take the following +values: +
        +
        Build:
        +
        State entered after the first allocation, and before the + first assembly; in this state it is possible to add nonzero entries. +
        +
        Assembled:
        +
        State entered after the assembly; computations using + the sparse matrix, such as matrix-vector products, are only possible + in this state; +
        +
        Update:
        +
        State entered after a reinitalization; this is used to + handle applications in which the same sparsity pattern is used + multiple times with different coefficients. In this state it is only + possible to enter coefficients for already existing nonzero entries. +
        +


        + +Subsections + + + +
        + + +next + +up + +previous + +contents +
        + Next: Named Constants + Up: Data Structures + Previous: Named Constants +   Contents + diff --git a/docs/html/node14.html b/docs/html/node14.html index 101909b16..d5714c059 100644 --- a/docs/html/node14.html +++ b/docs/html/node14.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -Data structure query routines - +Named Constants + @@ -18,59 +18,67 @@ original version by: Nikos Drakos, CBLU, University of Leeds - - + - next - + up - previous - contents
        - Next: psb_cd_get_local_rows Get - Up: Data Structures - Previous: Preconditioner data structure -   Next: Preconditioner data structure + Up: Dense Vector Data Structure + Previous: Dense Vector Data Structure +   Contents

        -

        - +

        +
        -Data structure query routines -

        -

        - -Subsections +Named Constants + +
        +
        psb_dupl_ovwrt_
        +
        Duplicate coefficients should be overwritten + (i.e. ignore duplications) +
        +
        psb_dupl_add_
        +
        Duplicate coefficients should be added; +
        +
        psb_dupl_err_
        +
        Duplicate coefficients should trigger an error conditino +
        +
        psb_upd_dflt_
        +
        Default update strategy for matrix coefficients; +
        +
        psb_upd_srch_
        +
        Update strategy based on search into the data structure; +
        +
        psb_upd_perm_
        +
        Update strategy based on additional + permutation data (see tools routine description). +
        +
        - - +



        diff --git a/docs/html/node15.html b/docs/html/node15.html index 1d1ed4bcc..f83e7847f 100644 --- a/docs/html/node15.html +++ b/docs/html/node15.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_cd_get_local_rows -- Get number of local rows - +Preconditioner data structure + @@ -19,86 +19,78 @@ original version by: Nikos Drakos, CBLU, University of Leeds - - + + - next - + up - previous - contents
        - Next: psb_cd_get_local_cols Get - Up: Data structure query routines - Previous: Data structure query routines -   Next: Data structure query routines + Up: Data Structures + Previous: Named Constants +   Contents

        -

        -psb_cd_get_local_rows -- Get number of local rows -

        +

        + +
        +Preconditioner data structure +

        +Our base library offers support for simple well known preconditioners +like Diagonal Scaling or Block Jacobi with incomplete +factorization ILU(0).

        -

        -nr = psb_cd_get_local_rows(desc)
        -
        +A preconditioner is held in the precdata psb_prec_type data structure reported in +figure 6. The psb_prec_type +data type may contain a simple preconditioning matrix with the +associated communication descriptor.The values contained in +the iprcparm and rprcparm define tha type of +preconditioner along with all the parameters related to it; thus, +iprcparm and rprcparm define how the other records have +to be interpreted. This data structure is the basis of more complex +preconditioning strategies, which are the subject of further +research. -

        -

        -
        Type:
        -
        Asynchronous. -
        -
        On Entry
        -
        -
        -
        desc
        -
        the communication descriptor. -
        -Scope: local. -
        -Type: required. -
        -Intent: in. -
        -Specified as: a structured data of type descdatapsb_desc_type. -
        -
        +
        + + + +
        Figure 6: +The PSBLAS defined data type that contains a preconditioner.

        -

        -

        -
        On Return
        -
        -
        -
        Function value
        -
        The number of local rows, i.e. the number of - rows owned by the current process; as explained in 1, - it is equal to $\vert{\cal I}_i\vert + \vert{\cal B}_i\vert$. The returned value is - specific to the calling process. -
        -
        + WIDTH="535" HEIGHT="218" ALIGN="MIDDLE" BORDER="0" + SRC="img20.png" + ALT="\fbox{\TheSbox}">
        +
        +



        diff --git a/docs/html/node16.html b/docs/html/node16.html index c0d74830c..a1d03c012 100644 --- a/docs/html/node16.html +++ b/docs/html/node16.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_cd_get_local_cols -- Get number of local cols - +Data structure query routines + @@ -18,90 +18,59 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - + - next - + up - previous - contents
        - Next: psb_cd_get_global_rows Get - Up: Data structure query routines - Previous: psb_cd_get_local_rows Get -   Next: get_local_rows Get + Up: Data Structures + Previous: Preconditioner data structure +   Contents

        -

        -psb_cd_get_local_cols -- Get number of local cols -

        - -

        -

        -nc = psb_cd_get_local_cols(desc)
        -
        - -

        -

        -
        On Entry
        -
        -
        -
        Type:
        -
        Asynchronous. -
        -
        desc
        -
        the communication descriptor. +

        +
        -Scope: local. -
        -Type: required. -
        -Intent: in. -
        -Specified as: a structured data of type descdatapsb_desc_type. -

        -
        +Data structure query routines + +

        + +Subsections -

        -

        -
        On Return
        -
        -
        -
        Function value
        -
        The number of local cols, i.e. the number of - indices used by the current process, including both local and halo - indices; as explained in 1, - it is equal to -$\vert{\cal I}_i\vert + \vert{\cal B}_i\vert +\vert{\cal H}_i\vert$. The - returned value is specific to the calling process. -
        -
        - -

        +

        +

        diff --git a/docs/html/node17.html b/docs/html/node17.html index f9e2d9377..1f8b780d2 100644 --- a/docs/html/node17.html +++ b/docs/html/node17.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_cd_get_global_rows -- Get number of global rows - +get_local_rows -- Get number of local rows + @@ -20,54 +20,54 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_cd_get_global_cols Get - Up: Data structure query routines - Previous: psb_cd_get_local_cols Get -   Next: get_local_cols Get + Up: Data structure query routines + Previous: Data structure query routines +   Contents

        -

        -psb_cd_get_global_rows -- Get number of global rows +

        +get_local_rows -- Get number of local rows

        -nr = psb_cd_get_global_rows(desc)
        +nr = desc%get_local_rows()
         

        -
        On Entry
        -
        -
        Type:
        Asynchronous.
        +
        On Entry
        +
        +
        desc
        the communication descriptor.
        @@ -87,7 +87,16 @@ Specified as: a structured data of type descdatapsb_desc_type.
        Function value
        -
        The number of global rows in the mesh +
        The number of local rows, i.e. the number of + rows owned by the current process; as explained in 1, + it is equal to +$\vert{\cal I}_i\vert + \vert{\cal B}_i\vert$. The returned value is + specific to the calling process.
        diff --git a/docs/html/node18.html b/docs/html/node18.html index 418c8d219..6088ff7e5 100644 --- a/docs/html/node18.html +++ b/docs/html/node18.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_cd_get_global_cols -- Get number of global cols - +get_local_cols -- Get number of local cols + @@ -18,55 +18,56 @@ original version by: Nikos Drakos, CBLU, University of Leeds + - + - next - + up - previous - contents
        - Next: psb_cd_get_context Get communication context - Up: Data structure query routines - Previous: psb_cd_get_global_rows Get -   Next: get_global_rows Get + Up: Data structure query routines + Previous: get_local_rows Get +   Contents

        -

        -psb_cd_get_global_cols -- Get number of global cols +

        +get_local_cols -- Get number of local cols

        -nr = psb_cd_get_global_cols(desc)
        +nc = desc%get_local_cols()
         

        -
        Type:
        -
        Asynchronous. -
        On Entry
        +
        Type:
        +
        Asynchronous. +
        desc
        the communication descriptor.
        @@ -86,7 +87,17 @@ Specified as: a structured data of type descdatapsb_desc_type.
        Function value
        -
        The number of global cols in the mesh +
        The number of local cols, i.e. the number of + indices used by the current process, including both local and halo + indices; as explained in 1, + it is equal to +$\vert{\cal I}_i\vert + \vert{\cal B}_i\vert +\vert{\cal H}_i\vert$. The + returned value is specific to the calling process.
        diff --git a/docs/html/node19.html b/docs/html/node19.html index db1371f62..ad0ed1834 100644 --- a/docs/html/node19.html +++ b/docs/html/node19.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_cd_get_context--Get communication context - +get_global_rows -- Get number of global rows + @@ -18,55 +18,56 @@ original version by: Nikos Drakos, CBLU, University of Leeds - - + + + - next - + up - previous - contents
        - Next: psb_cd_get_large_threshold Get - Up: Data Structures - Previous: psb_cd_get_global_cols Get -   Next: get_global_cols Get + Up: Data structure query routines + Previous: get_local_cols Get +   Contents

        -

        -
        -psb_cd_get_context--Get communication context -
        -

        +

        +get_global_rows -- Get number of global rows +

        + +

        -ictxt = psb_cd_get_context(desc)
        +nr = desc%get_global_rows()
         

        -
        Type:
        -
        Asynchronous. -
        On Entry
        +
        Type:
        +
        Asynchronous. +
        desc
        the communication descriptor.
        @@ -86,34 +87,12 @@ Specified as: a structured data of type descdatapsb_desc_type.
        Function value
        -
        The communication context. +
        The number of global rows in the mesh



        - -Subsections - - - -

        diff --git a/docs/html/node2.html b/docs/html/node2.html index 6a19f426c..98007878b 100644 --- a/docs/html/node2.html +++ b/docs/html/node2.html @@ -26,26 +26,26 @@ original version by: Nikos Drakos, CBLU, University of Leeds - next - up - previous - contents
        - Next: Next: General overview - Up: Up: userhtml - Previous: Previous: Contents -   Contents

        @@ -71,12 +71,12 @@ passing.

        The PSBLAS library is internally implemented in the Fortran 95 [14] programming language, with reuse and/or + HREF="node108.html#metcalf">14] programming language, with reuse and/or adaptation of some existing Fortran 77 software, and a handful of C routines. A similar approach has been advocated by a number of authors, e.g. [13]. Moreover, the Fortran 95 facilities for dynamic + HREF="node108.html#machiels">13]. Moreover, the Fortran 95 facilities for dynamic memory management and interface overloading greatly enhance the usability of the PSBLAS subroutines. In this way, the library can take care of runtime memory @@ -91,12 +91,12 @@ Fortran compiler from the Free Software Foundation (as of version 4.2). The presentation of the PSBLAS library follows the general structure of the proposal for serial Sparse BLAS [7,8], which in its turn is based on the + HREF="node108.html#sblas97">7,8], which in its turn is based on the proposal for BLAS on dense matrices [12,4,5]. + HREF="node108.html#BLAS1">12,4,5].

        The applicability of sparse iterative solvers to many different areas @@ -130,26 +130,26 @@ computational fluid dynamics applications.


        - next - up - previous - contents
        - Next: Next: General overview - Up: Up: userhtml - Previous: Previous: Contents -   Contents diff --git a/docs/html/node20.html b/docs/html/node20.html index a74d2ef9f..16428cb39 100644 --- a/docs/html/node20.html +++ b/docs/html/node20.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_cd_get_large_threshold -- Get threshold for index mapping switch - +get_global_cols -- Get number of global cols + @@ -18,46 +18,45 @@ original version by: Nikos Drakos, CBLU, University of Leeds - - + - next - + up - previous - contents
        - Next: psb_cd_set_large_threshold Set - Up: psb_cd_get_context Get communication context - Previous: psb_cd_get_context Get communication context -   Next: get_context Get communication context + Up: Data structure query routines + Previous: get_global_rows Get +   Contents

        -

        -psb_cd_get_large_threshold -- Get threshold for - index mapping switch +

        +get_global_cols -- Get number of global cols

        +

        -ith = psb_cd_get_large_threshold()
        +nr = desc%get_global_cols()
         

        @@ -65,13 +64,29 @@ ith = psb_cd_get_large_threshold()

        Type:
        Asynchronous.
        +
        On Entry
        +
        +
        +
        desc
        +
        the communication descriptor. +
        +Scope: local. +
        +Type: required. +
        +Intent: in. +
        +Specified as: a structured data of type descdatapsb_desc_type. +
        + + +

        +

        On Return
        Function value
        -
        The current value for the size threshold. - -

        +

        The number of global cols in the mesh
        diff --git a/docs/html/node21.html b/docs/html/node21.html index 7a6fd4f7e..f67e2feaa 100644 --- a/docs/html/node21.html +++ b/docs/html/node21.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_cd_set_large_threshold -- Set threshold for index mapping switch - +get_context--Get communication context + @@ -18,9 +18,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds - - - + + @@ -30,9 +29,9 @@ original version by: Nikos Drakos, CBLU, University of Leeds HREF="node22.html"> next + HREF="node8.html"> up - previous
        Next: psb_sp_get_nrows Get + HREF="node22.html">psb_cd_get_large_threshold Get Up: psb_cd_get_context Get communication context - Previous: psb_cd_get_large_threshold Get + HREF="node8.html">Data Structures + Previous: get_global_cols Get   Contents

        -

        -psb_cd_set_large_threshold -- Set threshold for - index mapping switch -

        - +

        +
        +get_context--Get communication context +
        +

        -call psb_cd_set_large_threshold(ith)
        +ictxt = desc%get_context()
         

        @@ -68,23 +67,50 @@ call psb_cd_set_large_threshold(ith)

        On Entry
        -
        ith
        -
        the new threshold for communication descriptors. +
        desc
        +
        the communication descriptor.
        -Scope: global. +Scope: local.
        Type: required.
        Intent: in.
        -Specified as: an integer value greater than zero. +Specified as: a structured data of type descdatapsb_desc_type.
        -Note: the threshold value is only queried by the library at the time a -call to psb_cdall is executed, therefore changing the threshold -has no effect on communication descriptors that have already been initialized.

        +

        +
        On Return
        +
        +
        +
        Function value
        +
        The communication context. +
        +
        + +

        +


        + +Subsections + + +

        diff --git a/docs/html/node22.html b/docs/html/node22.html index 1d252791f..1773ed2d9 100644 --- a/docs/html/node22.html +++ b/docs/html/node22.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_sp_get_nrows -- Get number of rows in a sparse matrix - +psb_cd_get_large_threshold -- Get threshold for index mapping switch + @@ -20,45 +20,44 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_sp_get_ncols Get - Up: psb_cd_get_context Get communication context - Previous: psb_cd_set_large_threshold Set -   Next: psb_cd_set_large_threshold Set + Up: get_context Get communication context + Previous: get_context Get communication context +   Contents

        -

        -psb_sp_get_nrows -- Get number of rows in a sparse - matrix +

        +psb_cd_get_large_threshold -- Get threshold for + index mapping switch

        -

        -nr = psb_sp_get_nrows(a)
        +ith = psb_cd_get_large_threshold()
         

        @@ -66,29 +65,13 @@ nr = psb_sp_get_nrows(a)

        Type:
        Asynchronous.
        -
        On Entry
        -
        -
        -
        a
        -
        the sparse matrix -
        -Scope: local -
        -Type: required -
        -Intent: in. -
        -Specified as: a structured data of type spdatapsb_spmat_type. -
        - - -

        -

        On Return
        Function value
        -
        The number of rows of sparse matrix a. +
        The current value for the size threshold. + +

        diff --git a/docs/html/node23.html b/docs/html/node23.html index 3720aaff2..d663d4458 100644 --- a/docs/html/node23.html +++ b/docs/html/node23.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_sp_get_ncols -- Get number of columns in a sparse matrix - +psb_cd_set_large_threshold -- Set threshold for index mapping switch + @@ -20,45 +20,44 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_sp_get_nnzeros Get - Up: psb_cd_get_context Get communication context - Previous: psb_sp_get_nrows Get -   Next: get_nrows Get + Up: get_context Get communication context + Previous: psb_cd_get_large_threshold Get +   Contents

        -

        -psb_sp_get_ncols -- Get number of columns in a - sparse matrix +

        +psb_cd_set_large_threshold -- Set threshold for + index mapping switch

        -

        -nr = psb_sp_get_ncols(a)
        +call psb_cd_set_large_threshold(ith)
         

        @@ -69,28 +68,21 @@ nr = psb_sp_get_ncols(a)

        On Entry
        -
        a
        -
        the sparse matrix +
        ith
        +
        the new threshold for communication descriptors.
        -Scope: local +Scope: global.
        -Type: required +Type: required.
        Intent: in.
        -Specified as: a structured data of type spdatapsb_spmat_type. -
        - - -

        -

        -
        On Return
        -
        -
        -
        Function value
        -
        The number of columns of sparse matrix a. +Specified as: an integer value greater than zero.
        +Note: the threshold value is only queried by the library at the time a +call to psb_cdall is executed, therefore changing the threshold +has no effect on communication descriptors that have already been initialized.



        diff --git a/docs/html/node24.html b/docs/html/node24.html index 5d45ff820..f7c660bba 100644 --- a/docs/html/node24.html +++ b/docs/html/node24.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_sp_get_nnzeros -- Get number of nonzero elements in a sparse matrix - +get_nrows -- Get number of rows in a sparse matrix + @@ -18,46 +18,46 @@ original version by: Nikos Drakos, CBLU, University of Leeds + - + - next - + up - previous - contents
        - Next: Computational routines - Up: psb_cd_get_context Get communication context - Previous: psb_sp_get_ncols Get -   Next: get_ncols Get + Up: get_context Get communication context + Previous: psb_cd_set_large_threshold Set +   Contents

        -

        -psb_sp_get_nnzeros -- Get number of nonzero elements - in a sparse matrix +

        +get_nrows -- Get number of rows in a sparse matrix

        -nr = psb_sp_get_nnzeros(a)
        +nr = a%get_nrows()
         

        @@ -87,20 +87,10 @@ Specified as: a structured data of type spdatapsb_spmat_type.

        Function value
        -
        The number of nonzero elements stored in sparse matrix a. +
        The number of rows of sparse matrix a.
        -

        -Notes - -

          -
        1. The function value is specific to the storage format of matrix - a; some storage formats employ padding, thus the returned - value for the same matrix may be different for different storage choices. -
        2. -
        -



        diff --git a/docs/html/node25.html b/docs/html/node25.html index ee7605f7b..5316f32be 100644 --- a/docs/html/node25.html +++ b/docs/html/node25.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -Computational routines - +get_ncols -- Get number of columns in a sparse matrix + @@ -18,75 +18,80 @@ original version by: Nikos Drakos, CBLU, University of Leeds - - - + + + - next - + up - previous - contents
        - Next: psb_geaxpby General - Up: userhtml - Previous: psb_sp_get_nnzeros Get -   Next: get_nnzeros Get + Up: get_context Get communication context + Previous: get_nrows Get +   Contents

        -

        -Computational routines -

        +

        +get_ncols -- Get number of columns in a sparse matrix +

        -


        - -Subsections +
        +nr = a%get_ncols()
        +
        - - +

        +

        +
        Type:
        +
        Asynchronous. +
        +
        On Entry
        +
        +
        +
        a
        +
        the sparse matrix +
        +Scope: local +
        +Type: required +
        +Intent: in. +
        +Specified as: a structured data of type spdatapsb_spmat_type. +
        +
        + +

        +

        +
        On Return
        +
        +
        +
        Function value
        +
        The number of columns of sparse matrix a. +
        +
        + +



        diff --git a/docs/html/node26.html b/docs/html/node26.html index 78e5c0479..82c9a0308 100644 --- a/docs/html/node26.html +++ b/docs/html/node26.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_geaxpby -- General Dense Matrix Sum - +get_nnzeros -- Get number of nonzero elements in a sparse matrix + @@ -18,203 +18,66 @@ original version by: Nikos Drakos, CBLU, University of Leeds - - + - next - + up - previous - contents
        - Next: psb_gedot Dot - Up: Computational routines - Previous: Computational routines -   Next: Computational routines + Up: get_context Get communication context + Previous: get_ncols Get +   Contents

        -

        -psb_geaxpby -- General Dense Matrix Sum -

        - -

        -This subroutine is an interface to the computational kernel for -dense matrix sum: -

        -
        - - -\begin{displaymath}y \leftarrow \alpha\> x+ \beta y \end{displaymath} -
        -
        -

        +

        +get_nnzeros -- Get number of nonzero elements + in a sparse matrix +

        -call psb_geaxpby(alpha, x, beta, y, desc_a, info)
        +nr = a%get_nnzeros()
         
        -

        -

        -
        - - - -
        Table 1: -Data types
        -
        - - - - - - - - - - - - - - - - -
        $x$, $y$, $\alpha$, $\beta$Subroutine
        Short Precision Realpsb_geaxpby
        Long Precision Realpsb_geaxpby
        Short Precision Complexpsb_geaxpby
        Long Precision Complexpsb_geaxpby
        -
        -
        -

        -
        -

        Type:
        -
        Synchronous. +
        Asynchronous.
        On Entry
        -
        alpha
        -
        the scalar $\alpha$. +
        a
        +
        the sparse matrix
        -Scope: global -
        -Type: required -
        -Intent: in. -
        -Specified as: a number of the data type indicated in Table 1. -
        -
        x
        -
        the local portion of global dense matrix -$x$. -
        -Scope: local -
        -Type: required -
        -Intent: in. -
        -Specified as: a rank one or two array -containing numbers of type -specified in Table 1. The rank of $x$ must be the same of $y$. -
        -
        beta
        -
        the scalar $\beta$. -
        -Scope: global -
        -Type: required -
        -Intent: in. -
        -Specified as: a number of the data type indicated in Table 1. -
        -
        y
        -
        the local portion of the global dense matrix -$y$. -
        -Scope: local -
        -Type: required -
        -Intent: inout. -
        -Specified as: a rank one or two array containing numbers of the type -indicated in Table 1. The rank of $y$ must be the same of $x$. -
        -
        desc_a
        -
        contains data structures for communications. -
        -Scope: local +Scope: local
        Type: required
        Intent: in.
        -Specified as: a structured data of type descdatapsb_desc_type. - -

        +Specified as: a structured data of type spdatapsb_spmat_type.

        @@ -223,59 +86,23 @@ Specified as: a structured data of type descdatapsb_desc_type.
        On Return
        -
        y
        -
        the local portion of result submatrix $y$. -
        -Scope: local -
        -Type: required -
        -Intent: inout. -
        -Specified as: a rank one or two array containing numbers of the type -indicated in Table 1. -
        -
        info
        -
        Error code. -
        -Scope: local -
        -Type: required -
        -Intent: out. -
        -An integer value; 0 means no error has been detected. +
        Function value
        +
        The number of nonzero elements stored in sparse matrix a.

        -


        - - -next - -up - -previous - -contents -
        - Next: psb_gedot Dot - Up: Computational routines - Previous: Computational routines -   Contents - +Notes + +
          +
        1. The function value is specific to the storage format of matrix + a; some storage formats employ padding, thus the returned + value for the same matrix may be different for different storage choices. +
        2. +
        + +

        +


        diff --git a/docs/html/node27.html b/docs/html/node27.html index 6487e560f..262ee489e 100644 --- a/docs/html/node27.html +++ b/docs/html/node27.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_gedot -- Dot Product - +Computational routines + @@ -18,263 +18,76 @@ original version by: Nikos Drakos, CBLU, University of Leeds - - - + + + - next - + up - previous - contents
        - Next: psb_gedots Generalized - Up: Computational routines - Previous: psb_geaxpby General -   Next: psb_geaxpby General + Up: userhtml + Previous: get_nnzeros Get +   Contents

        -

        -psb_gedot -- Dot Product -

        +

        +Computational routines +

        -This function computes dot product between two vectors $x$ and -$y$. -
        -If $x$ and $y$ are real vectors -it computes dot-product as: -

        -
        - +

        + +Subsections -\begin{displaymath}dot \leftarrow x^T y\end{displaymath} -
        -
        -

        -Else if $x$ and $y$ are complex vectors then it computes dot-product as: -

        -
        - - -\begin{displaymath}dot \leftarrow x^H y\end{displaymath} -
        -
        -

        - -

        -

        -psb_gedot(x, y, desc_a, info)
        -
        -

        -
        - - - -
        Table 2: -Data types
        -
        - - - - - - - - - - - - - - - - -
        $dot$, $x$, $y$Function
        Short Precision Realpsb_gedot
        Long Precision Realpsb_gedot
        Short Precision Complexpsb_gedot
        Long Precision Complexpsb_gedot
        -
        -
        -

        -
        - -

        -

        -
        Type:
        -
        Synchronous. -
        -
        On Entry
        -
        -
        -
        x
        -
        the local portion of global dense matrix -$x$. -
        -Scope: local -
        -Type: required -
        -Intent: in. -
        -Specified as: an array of rank one or two -containing numbers of type specified in -Table 2. The rank of $x$ must be the same of $y$. -
        -
        y
        -
        the local portion of global dense matrix -$y$. -
        -Scope: local -
        -Type: required -
        -Intent: in. -
        -Specified as: an array of rank one or two -containing numbers of type specified in -Table 2. The rank of $y$ must be the same of $x$. -
        -
        desc_a
        -
        contains data structures for communications. -
        -Scope: local -
        -Type: required -
        -Intent: in. -
        -Specified as: a structured data of type descdatapsb_desc_type. - -

        -

        -
        On Return
        -
        -
        -
        Function value
        -
        is the dot product of subvectors $x$ and $y$. -
        -Scope: global -
        -Specified as: a number of the data type indicated in Table 2. -
        -
        info
        -
        Error code. -
        -Scope: local -
        -Type: required -
        -Intent: out. -
        -An integer value; 0 means no error has been detected. -
        -
        - -

        -


        - - -next - -up - -previous - -contents -
        - Next: psb_gedots Generalized - Up: Computational routines - Previous: psb_geaxpby General -   Contents - + + +

        diff --git a/docs/html/node28.html b/docs/html/node28.html index c100a7fa6..484db53b7 100644 --- a/docs/html/node28.html +++ b/docs/html/node28.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_gedots -- Generalized Dot Product - +psb_geaxpby -- General Dense Matrix Sum + @@ -20,117 +20,100 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_geamax Infinity-Norm - Up: Computational routines - Previous: psb_gedot Dot -   Next: psb_gedot Dot + Up: Computational routines + Previous: Computational routines +   Contents

        -

        -psb_gedots -- Generalized Dot Product +

        +psb_geaxpby -- General Dense Matrix Sum

        -This subroutine computes a series of dot products among the columns of -two dense matrices $x$ and $y$: +This subroutine is an interface to the computational kernel for +dense matrix sum:

        \begin{displaymath}res(i) \leftarrow x(:,i)^T y(:,i)\end{displaymath} + WIDTH="93" HEIGHT="27" BORDER="0" + SRC="img27.png" + ALT="\begin{displaymath}y \leftarrow \alpha\> x+ \beta y \end{displaymath}">

        -

        -If the matrices are complex, then the -usual convention applies, i.e. the conjugate transpose of $x$ is -used. If $x$ and $y$ are of rank one, then $res$ is a scalar, else it -is a rank one array. +

        -call psb_gedots(res, x, y, desc_a, info)
        +call psb_geaxpby(alpha, x, beta, y, desc_a, info)
         
        + +


        -
        +
        -
        Table 3: +Table 1: Data types
        + SRC="img29.png" + ALT="$y$">, $\alpha$, $\beta$ - + - + - + - +
        $res$, $x$, $y$ Subroutine
        Short Precision Realpsb_gedotspsb_geaxpby
        Long Precision Realpsb_gedotspsb_geaxpby
        Short Precision Complexpsb_gedotspsb_geaxpby
        Long Precision Complexpsb_gedotspsb_geaxpby
        @@ -147,12 +130,26 @@ Data types
        On Entry
        +
        alpha
        +
        the scalar $\alpha$. +
        +Scope: global +
        +Type: required +
        +Intent: in. +
        +Specified as: a number of the data type indicated in Table 1. +
        x
        the local portion of global dense matrix $x$. + WIDTH="13" HEIGHT="14" ALIGN="BOTTOM" BORDER="0" + SRC="img28.png" + ALT="$x$">.
        Scope: local
        @@ -160,37 +157,50 @@ Type: required
        Intent: in.
        -Specified as: an array of rank one or two -containing numbers of type specified in -Table 3. The rank of 1. The rank of $x$ must be the same of $y$.
        +
        beta
        +
        the scalar $\beta$. +
        +Scope: global +
        +Type: required +
        +Intent: in. +
        +Specified as: a number of the data type indicated in Table 1. +
        y
        -
        the local portion of global dense matrix +
        the local portion of the global dense matrix $y$.
        Scope: local
        Type: required
        -Intent: in. +Intent: inout.
        -Specified as: an array of rank one or two -containing numbers of type specified in -Table 3. The rank of 1. The rank of $y$ must be the same of $x$.
        desc_a
        @@ -203,25 +213,30 @@ Type: required Intent: in.
        Specified as: a structured data of type descdatapsb_desc_type. + +

        + + +

        +

        On Return
        -
        res
        -
        is the dot product of subvectors $x$ and y +
        the local portion of result submatrix $y$.
        -Scope: global +Scope: local
        -Intent: out. +Type: required
        -Specified as: a number or a rank-one array of the data type indicated -in Table 2. +Intent: inout. +
        +Specified as: a rank one or two array containing numbers of the type +indicated in Table 1.
        info
        Error code. @@ -239,26 +254,26 @@ An integer value; 0 means no error has been detected.


        - next - + up - previous - contents
        - Next: psb_geamax Infinity-Norm - Up: Computational routines - Previous: psb_gedot Dot -   Next: psb_gedot Dot + Up: Computational routines + Previous: Computational routines +   Contents diff --git a/docs/html/node29.html b/docs/html/node29.html index be6a9d76c..342d34009 100644 --- a/docs/html/node29.html +++ b/docs/html/node29.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_geamax -- Infinity-Norm of Vector - +psb_gedot -- Dot Product + @@ -20,127 +20,132 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_geamaxs Generalized - Up: Computational routines - Previous: psb_gedots Generalized -   Next: psb_gedots Generalized + Up: Computational routines + Previous: psb_geaxpby General +   Contents

        -

        -psb_geamax -- Infinity-Norm of Vector +

        +psb_gedot -- Dot Product

        -This function computes - the infinity-norm of a vector $x$. +This function computes dot product between two vectors $x$ and +$y$.
        If $x$ is a real vector -it computes infinity norm as: + WIDTH="13" HEIGHT="14" ALIGN="BOTTOM" BORDER="0" + SRC="img28.png" + ALT="$x$"> and $y$ are real vectors +it computes dot-product as:

        \begin{displaymath}amax \leftarrow \max_i \vert x_i\vert\end{displaymath} + WIDTH="74" HEIGHT="27" BORDER="0" + SRC="img32.png" + ALT="\begin{displaymath}dot \leftarrow x^T y\end{displaymath}">

        -else if $x$ is a complex vector then it computes infinity-norm as: +Else if $x$ and $y$ are complex vectors then it computes dot-product as:

        \begin{displaymath}amax \leftarrow \max_i {(\vert re(x_i)\vert + \vert im(x_i)\vert)}\end{displaymath} + WIDTH="75" HEIGHT="27" BORDER="0" + SRC="img33.png" + ALT="\begin{displaymath}dot \leftarrow x^H y\end{displaymath}">

        -psb_geamax(x, desc_a, info)
        +psb_gedot(x, y, desc_a, info)
         
        - -


        -
        +
        -
        Table 4: +Table 2: Data types
        - + WIDTH="25" HEIGHT="15" ALIGN="BOTTOM" BORDER="0" + SRC="img34.png" + ALT="$dot$">, $x$, $y$ - - + - - + - - - + + - - - + +
        $amax$$x$ Function
        Short Precision RealShort Precision Realpsb_geamaxpsb_gedot
        Long Precision RealLong Precision Realpsb_geamaxpsb_gedot
        Short Precision RealShort Precision Complexpsb_geamax
        Short Precision Complexpsb_gedot
        Long Precision RealLong Precision Complexpsb_geamax
        Long Precision Complexpsb_gedot
        @@ -160,10 +165,9 @@ Data types
        x
        the local portion of global dense matrix $x$. - + WIDTH="13" HEIGHT="14" ALIGN="BOTTOM" BORDER="0" + SRC="img28.png" + ALT="$x$">.
        Scope: local
        @@ -171,9 +175,38 @@ Type: required
        Intent: in.
        -Specified as: a rank one or two array +Specified as: an array of rank one or two containing numbers of type specified in -Table 4. +Table 2. The rank of $x$ must be the same of $y$. +
        +
        y
        +
        the local portion of global dense matrix +$y$. +
        +Scope: local +
        +Type: required +
        +Intent: in. +
        +Specified as: an array of rank one or two +containing numbers of type specified in +Table 2. The rank of $y$ must be the same of $x$.
        desc_a
        contains data structures for communications. @@ -192,14 +225,17 @@ Specified as: a structured data of type descdatapsb_desc_type.
        Function value
        -
        is the infinity norm of subvector $x$. +
        is the dot product of subvectors $x$ and $y$.
        Scope: global
        -Specified as: a long precision real number. +Specified as: a number of the data type indicated in Table 2.
        info
        Error code. @@ -217,26 +253,26 @@ An integer value; 0 means no error has been detected.


        - next - + up - previous - contents
        - Next: psb_geamaxs Generalized - Up: Computational routines - Previous: psb_gedots Generalized -   Next: psb_gedots Generalized + Up: Computational routines + Previous: psb_geaxpby General +   Contents diff --git a/docs/html/node3.html b/docs/html/node3.html index d95200c0f..c2215b8c5 100644 --- a/docs/html/node3.html +++ b/docs/html/node3.html @@ -26,26 +26,26 @@ original version by: Nikos Drakos, CBLU, University of Leeds - next - up - previous - contents
        - Next: Next: Basic Nomenclature - Up: Up: userhtml - Previous: Previous: Introduction -   Contents

        @@ -77,7 +77,7 @@ The serial parts of the computation on each process are executed through calls to the serial sparse BLAS subroutines. In a similar way, the inter-process message exchanges are implemented through the Basic Linear Algebra Communication Subroutines (BLACS) library [6] + HREF="node108.html#BLACS">6] that guarantees a portable and efficient communication layer. The Message Passing Interface code is encapsulated within the BLACS layer. However, in some cases, MPI routines are directly used either @@ -86,7 +86,7 @@ the BLACS package doesn't provide any method.

        In any case we provide wrappers around the BLACS routines so that the -user does not need to delve into their details (see Sec. 7). +user does not need to delve into their details (see Sec. 7).

        @@ -97,7 +97,7 @@ PSBLAS library components hierarchy.

        \includegraphics[scale=0.65]{figures/psblas.eps} @@ -141,7 +141,7 @@ as well as completely arbitrary assignments of equation indices to processes. In particular it is consistent with the usage of graph partitioning tools commonly available in the literature, e.g. METIS [11]. + HREF="node108.html#METIS">11]. Dense vectors conform to sparse matrices, that is, the entries of a vector follow the same distribution of the matrix rows. @@ -161,38 +161,38 @@ bottleneck would make this option unattractive in most cases. Subsections
        - next - up - previous - contents
        - Next: Next: Basic Nomenclature - Up: Up: userhtml - Previous: Previous: Introduction -   Contents diff --git a/docs/html/node30.html b/docs/html/node30.html index 5d14f8465..3354e4ea5 100644 --- a/docs/html/node30.html +++ b/docs/html/node30.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_geamaxs -- Generalized Infinity Norm - +psb_gedots -- Generalized Dot Product + @@ -20,102 +20,117 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_geasum 1-Norm - Up: Computational routines - Previous: psb_geamax Infinity-Norm -   Next: psb_geamax Infinity-Norm + Up: Computational routines + Previous: psb_gedot Dot +   Contents

        -

        -psb_geamaxs -- Generalized Infinity Norm +

        +psb_gedots -- Generalized Dot Product

        -This subroutine computes a series of infinity norms on the columns of -a dense matrix $x$: +This subroutine computes a series of dot products among the columns of +two dense matrices $x$ and $y$:

        \begin{displaymath}res(i) \leftarrow \max_k \vert x(k,i)\vert \end{displaymath} + WIDTH="150" HEIGHT="28" BORDER="0" + SRC="img35.png" + ALT="\begin{displaymath}res(i) \leftarrow x(:,i)^T y(:,i)\end{displaymath}">

        +If the matrices are complex, then the +usual convention applies, i.e. the conjugate transpose of $x$ is +used. If $x$ and $y$ are of rank one, then $res$ is a scalar, else it +is a rank one array.

        -call psb_geamaxs(res, x, desc_a, info)
        +call psb_gedots(res, x, y, desc_a, info)
         
        - -


        -
        +
        -
        Table 5: +Table 3: Data types
        - + WIDTH="26" HEIGHT="14" ALIGN="BOTTOM" BORDER="0" + SRC="img36.png" + ALT="$res$">, $x$, $y$ - - + - - + - - - + + - - - + +
        $res$$x$ Subroutine
        Short Precision RealShort Precision Realpsb_geamaxspsb_gedots
        Long Precision RealLong Precision Realpsb_geamaxspsb_gedots
        Short Precision RealShort Precision Complexpsb_geamaxs
        Short Precision Complexpsb_gedots
        Long Precision RealLong Precision Complexpsb_geamaxs
        Long Precision Complexpsb_gedots
        @@ -135,8 +150,8 @@ Data types
        x
        the local portion of global dense matrix $x$.
        Scope: local @@ -145,9 +160,38 @@ Type: required
        Intent: in.
        -Specified as: a rank one or two array +Specified as: an array of rank one or two containing numbers of type specified in -Table 5. +Table 3. The rank of $x$ must be the same of $y$. +
        +
        y
        +
        the local portion of global dense matrix +$y$. +
        +Scope: local +
        +Type: required +
        +Intent: in. +
        +Specified as: an array of rank one or two +containing numbers of type specified in +Table 3. The rank of $y$ must be the same of $x$.
        desc_a
        contains data structures for communications. @@ -164,16 +208,20 @@ Specified as: a structured data of type descdatapsb_desc_type.
        res
        -
        is the infinity norm of the columns of $x$. +
        is the dot product of subvectors $x$ and $y$.
        Scope: global
        Intent: out.
        -Specified as: a number or a rank-one array of long precision real numbers. +Specified as: a number or a rank-one array of the data type indicated +in Table 2.
        info
        Error code. @@ -191,26 +239,26 @@ An integer value; 0 means no error has been detected.


        - next - + up - previous - contents
        - Next: psb_geasum 1-Norm - Up: Computational routines - Previous: psb_geamax Infinity-Norm -   Next: psb_geamax Infinity-Norm + Up: Computational routines + Previous: psb_gedot Dot +   Contents diff --git a/docs/html/node31.html b/docs/html/node31.html index 434024ad8..980769aef 100644 --- a/docs/html/node31.html +++ b/docs/html/node31.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_geasum -- 1-Norm of Vector - +psb_geamax -- Infinity-Norm of Vector + @@ -20,126 +20,127 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_geasums Generalized - Up: Computational routines - Previous: psb_geamaxs Generalized -   Next: psb_geamaxs Generalized + Up: Computational routines + Previous: psb_gedots Generalized +   Contents

        -

        -psb_geasum -- 1-Norm of Vector +

        +psb_geamax -- Infinity-Norm of Vector

        -This function computes the 1-norm of a vector $x$.
        If $x$ is a real vector -it computes 1-norm as: + WIDTH="13" HEIGHT="14" ALIGN="BOTTOM" BORDER="0" + SRC="img28.png" + ALT="$x$"> is a real vector +it computes infinity norm as:

        \begin{displaymath}asum \leftarrow \Vert x_i\Vert\end{displaymath} + WIDTH="118" HEIGHT="36" BORDER="0" + SRC="img37.png" + ALT="\begin{displaymath}amax \leftarrow \max_i \vert x_i\vert\end{displaymath}">

        else if $x$ is a vector then it computes 1-norm as: + WIDTH="13" HEIGHT="14" ALIGN="BOTTOM" BORDER="0" + SRC="img28.png" + ALT="$x$"> is a complex vector then it computes infinity-norm as:

        \begin{displaymath}asum \leftarrow \Vert re(x)\Vert _1 + \Vert im(x)\Vert _1\end{displaymath} + WIDTH="233" HEIGHT="36" BORDER="0" + SRC="img38.png" + ALT="\begin{displaymath}amax \leftarrow \max_i {(\vert re(x_i)\vert + \vert im(x_i)\vert)}\end{displaymath}">

        -psb_geasum(x, desc_a, info)
        +psb_geamax(x, desc_a, info)
         


        -
        +
        -
        Table 6: +Table 4: Data types
        + WIDTH="44" HEIGHT="14" ALIGN="BOTTOM" BORDER="0" + SRC="img39.png" + ALT="$amax$"> - + - + - + - +
        $asum$ $x$ Function
        Short Precision Real Short Precision Realpsb_geasumpsb_geamax
        Long Precision Real Long Precision Realpsb_geasumpsb_geamax
        Short Precision Real Short Precision Complexpsb_geasumpsb_geamax
        Long Precision Real Long Precision Complexpsb_geasumpsb_geamax
        @@ -159,8 +160,8 @@ Data types
        x
        the local portion of global dense matrix $x$.
        @@ -170,9 +171,9 @@ Type: required
        Intent: in.
        -Specified as: a rank one or two array +Specified as: a rank one or two array containing numbers of type specified in -Table 6. +Table 4.
        desc_a
        contains data structures for communications. @@ -191,14 +192,14 @@ Specified as: a structured data of type descdatapsb_desc_type.
        Function value
        -
        is the 1-norm of vector is the infinity norm of subvector $x$.
        Scope: global
        -Specified as: a long precision real number. +Specified as: a long precision real number.
        info
        Error code. @@ -216,26 +217,26 @@ An integer value; 0 means no error has been detected.


        - next - + up - previous - contents
        - Next: psb_geasums Generalized - Up: Computational routines - Previous: psb_geamaxs Generalized -   Next: psb_geamaxs Generalized + Up: Computational routines + Previous: psb_gedots Generalized +   Contents diff --git a/docs/html/node32.html b/docs/html/node32.html index 7289fd3dd..5a69d19c7 100644 --- a/docs/html/node32.html +++ b/docs/html/node32.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_geasums -- Generalized 1-Norm of Vector - +psb_geamaxs -- Generalized Infinity Norm + @@ -20,46 +20,46 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_genrm2 2-Norm - Up: Computational routines - Previous: psb_geasum 1-Norm -   Next: psb_geasum 1-Norm + Up: Computational routines + Previous: psb_geamax Infinity-Norm +   Contents

        -

        -psb_geasums -- Generalized 1-Norm of Vector +

        +psb_geamaxs -- Generalized Infinity Norm

        -This subroutine computes a series of 1-norms on the columns of +This subroutine computes a series of infinity norms on the columns of a dense matrix $x$:

        @@ -70,96 +70,52 @@ res(i) \leftarrow \max_k |x(k,i)| --> \begin{displaymath}res(i) \leftarrow \max_k \vert x(k,i)\vert \end{displaymath}

        -This function computes the 1-norm of a vector $x$. -
        -If $x$ is a real vector -it computes 1-norm as: -

        -
        - - -\begin{displaymath}res(i) \leftarrow \Vert x_i\Vert\end{displaymath} -
        -
        -

        -else if $x$ is a complex vector then it computes 1-norm as: -

        -
        - - -\begin{displaymath}res(i) \leftarrow \Vert re(x)\Vert _1 + \Vert im(x)\Vert _1\end{displaymath} -
        -
        -

        -call psb_geasums(res, x, desc_a, info)
        +call psb_geamaxs(res, x, desc_a, info)
         


        -
        +
        -
        Table 7: +Table 5: Data types
        - + - + - + - +
        $res$ $x$ Subroutine
        Short Precision Real Short Precision Realpsb_geasumspsb_geamaxs
        Long Precision Real Long Precision Realpsb_geasumspsb_geamaxs
        Short Precision Real Short Precision Complexpsb_geasumspsb_geamaxs
        Long Precision Real Long Precision Complexpsb_geasumspsb_geamaxs
        @@ -179,10 +135,9 @@ Data types
        x
        the local portion of global dense matrix $x$. -
        Scope: local
        @@ -192,7 +147,7 @@ Intent: in.
        Specified as: a rank one or two array containing numbers of type specified in -Table 7. +Table 5.
        desc_a
        contains data structures for communications. @@ -204,24 +159,21 @@ Type: required Intent: in.
        Specified as: a structured data of type descdatapsb_desc_type. - -

        On Return
        res
        -
        contains the 1-norm of (the columns of) is the infinity norm of the columns of $x$.
        Scope: global
        Intent: out.
        -Short as: a long precision real number. -Specified as: a long precision real number. +Specified as: a number or a rank-one array of long precision real numbers.
        info
        Error code. @@ -239,26 +191,26 @@ An integer value; 0 means no error has been detected.


        - next - + up - previous - contents
        - Next: psb_genrm2 2-Norm - Up: Computational routines - Previous: psb_geasum 1-Norm -   Next: psb_geasum 1-Norm + Up: Computational routines + Previous: psb_geamax Infinity-Norm +   Contents diff --git a/docs/html/node33.html b/docs/html/node33.html index 7852a9294..2cedc7df2 100644 --- a/docs/html/node33.html +++ b/docs/html/node33.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_genrm2 -- 2-Norm of Vector - +psb_geasum -- 1-Norm of Vector + @@ -20,121 +20,126 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_genrm2s Generalized - Up: Computational routines - Previous: psb_geasums Generalized -   Next: psb_geasums Generalized + Up: Computational routines + Previous: psb_geamaxs Generalized +   Contents

        -

        -psb_genrm2 -- 2-Norm of Vector +

        +psb_geasum -- 1-Norm of Vector

        -This function computes the 2-norm of a vector $x$.
        If $x$ is a double precision real vector -it computes 2-norm as: + WIDTH="13" HEIGHT="14" ALIGN="BOTTOM" BORDER="0" + SRC="img28.png" + ALT="$x$"> is a real vector +it computes 1-norm as:

        \begin{displaymath}nrm2 \leftarrow \sqrt{x^T x}\end{displaymath} + WIDTH="92" HEIGHT="28" BORDER="0" + SRC="img41.png" + ALT="\begin{displaymath}asum \leftarrow \Vert x_i\Vert\end{displaymath}">

        else if $x$ is double precision complex vector then it computes 2-norm as: + WIDTH="13" HEIGHT="14" ALIGN="BOTTOM" BORDER="0" + SRC="img28.png" + ALT="$x$"> is a vector then it computes 1-norm as:

        \begin{displaymath}nrm2 \leftarrow \sqrt{x^H x}\end{displaymath} + WIDTH="205" HEIGHT="28" BORDER="0" + SRC="img42.png" + ALT="\begin{displaymath}asum \leftarrow \Vert re(x)\Vert _1 + \Vert im(x)\Vert _1\end{displaymath}">

        +

        +

        +psb_geasum(x, desc_a, info)
        +
        +


        -
        +
        -
        Table 8: +Table 6: Data types
        + WIDTH="43" HEIGHT="14" ALIGN="BOTTOM" BORDER="0" + SRC="img43.png" + ALT="$asum$"> - + - + - + - +
        $nrm2$ $x$ Function
        Short Precision Real Short Precision Realpsb_genrm2psb_geasum
        Long Precision Real Long Precision Realpsb_genrm2psb_geasum
        Short Precision Real Short Precision Complexpsb_genrm2psb_geasum
        Long Precision Real Long Precision Complexpsb_genrm2psb_geasum
        @@ -143,11 +148,6 @@ Data types


        -

        -

        -psb_genrm2(x, desc_a, info)
        -
        -

        Type:
        @@ -159,9 +159,10 @@ psb_genrm2(x, desc_a, info)
        x
        the local portion of global dense matrix $x$. + WIDTH="13" HEIGHT="14" ALIGN="BOTTOM" BORDER="0" + SRC="img28.png" + ALT="$x$">. +
        Scope: local
        @@ -169,9 +170,9 @@ Type: required
        Intent: in.
        -Specified as: a rank one or two array +Specified as: a rank one or two array containing numbers of type specified in -Table 8. +Table 6.
        desc_a
        contains data structures for communications. @@ -189,17 +190,15 @@ Specified as: a structured data of type descdatapsb_desc_type.
        On Return
        -
        Function Value
        -
        is the 2-norm of subvector Function value +
        is the 1-norm of vector $x$.
        Scope: global
        -Type: required -
        -Specified as: a long precision real number. +Specified as: a long precision real number.
        info
        Error code. @@ -217,26 +216,26 @@ An integer value; 0 means no error has been detected.


        - next - + up - previous - contents
        - Next: psb_genrm2s Generalized - Up: Computational routines - Previous: psb_geasums Generalized -   Next: psb_geasums Generalized + Up: Computational routines + Previous: psb_geamaxs Generalized +   Contents diff --git a/docs/html/node34.html b/docs/html/node34.html index 002ecf358..2bca0e96e 100644 --- a/docs/html/node34.html +++ b/docs/html/node34.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_genrm2s -- Generalized 2-Norm of Vector - +psb_geasums -- Generalized 1-Norm of Vector + @@ -20,102 +20,146 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_spnrmi Infinity - Up: Computational routines - Previous: psb_genrm2 2-Norm -   Next: psb_genrm2 2-Norm + Up: Computational routines + Previous: psb_geasum 1-Norm +   Contents

        -

        -psb_genrm2s -- Generalized 2-Norm of Vector +

        +psb_geasums -- Generalized 1-Norm of Vector

        -This subroutine computes a series of 2-norms on the columns of +This subroutine computes a series of 1-norms on the columns of a dense matrix $x$:

        \begin{displaymath}res(i) \leftarrow \Vert x(:,i)\Vert _2 \end{displaymath} + WIDTH="148" HEIGHT="36" BORDER="0" + SRC="img40.png" + ALT="\begin{displaymath}res(i) \leftarrow \max_k \vert x(k,i)\vert \end{displaymath}"> +
        +
        +

        +This function computes the 1-norm of a vector $x$. +
        +If $x$ is a real vector +it computes 1-norm as: +

        +
        + + +\begin{displaymath}res(i) \leftarrow \Vert x_i\Vert\end{displaymath} +
        +
        +

        +else if $x$ is a complex vector then it computes 1-norm as: +

        +
        + + +\begin{displaymath}res(i) \leftarrow \Vert re(x)\Vert _1 + \Vert im(x)\Vert _1\end{displaymath}

        -call psb_genrm2s(res, x, desc_a, info)
        +call psb_geasums(res, x, desc_a, info)
         


        -
        +
        -
        Table 9: +Table 7: Data types
        - + - + - + - +
        $res$ $x$ Subroutine
        Short Precision Real Short Precision Realpsb_genrm2spsb_geasums
        Long Precision Real Long Precision Realpsb_genrm2spsb_geasums
        Short Precision Real Short Precision Complexpsb_genrm2spsb_geasums
        Long Precision Real Long Precision Complexpsb_genrm2spsb_geasums
        @@ -135,8 +179,8 @@ Data types
        x
        the local portion of global dense matrix $x$.
        @@ -148,7 +192,7 @@ Intent: in.
        Specified as: a rank one or two array containing numbers of type specified in -Table 9. +Table 7.
        desc_a
        contains data structures for communications. @@ -168,14 +212,15 @@ Specified as: a structured data of type descdatapsb_desc_type.
        res
        contains the 1-norm of (the columns of) $x$.
        Scope: global
        Intent: out.
        +Short as: a long precision real number. Specified as: a long precision real number.
        info
        @@ -194,26 +239,26 @@ An integer value; 0 means no error has been detected.


        - next - + up - previous - contents
        - Next: psb_spnrmi Infinity - Up: Computational routines - Previous: psb_genrm2 2-Norm -   Next: psb_genrm2 2-Norm + Up: Computational routines + Previous: psb_geasum 1-Norm +   Contents diff --git a/docs/html/node35.html b/docs/html/node35.html index 84b25c5bd..86a7b72ae 100644 --- a/docs/html/node35.html +++ b/docs/html/node35.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_spnrmi -- Infinity Norm of Sparse Matrix - +psb_genrm2 -- 2-Norm of Vector + @@ -20,102 +20,121 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_spmm Sparse - Up: Computational routines - Previous: psb_genrm2s Generalized -   Next: psb_genrm2s Generalized + Up: Computational routines + Previous: psb_geasums Generalized +   Contents

        -

        -psb_spnrmi -- Infinity Norm of Sparse Matrix +

        +psb_genrm2 -- 2-Norm of Vector

        -This function computes the infinity-norm of a matrix $A$: +This function computes the 2-norm of a vector $x$.
        -

        +If $x$ is a double precision real vector +it computes 2-norm as:

        \begin{displaymath}nrmi \leftarrow \Vert A\Vert _\infty \end{displaymath} + WIDTH="106" HEIGHT="24" BORDER="0" + SRC="img46.png" + ALT="\begin{displaymath}nrm2 \leftarrow \sqrt{x^T x}\end{displaymath}"> +
        +
        +

        +else if $x$ is double precision complex vector then it computes 2-norm as: +

        +
        + + +\begin{displaymath}nrm2 \leftarrow \sqrt{x^H x}\end{displaymath}

        -where: -
        -
        $A$
        -
        represents the global matrix $A$ -
        -


        -
        +
        -
        Table 10: +Table 8: Data types
        + WIDTH="43" HEIGHT="14" ALIGN="BOTTOM" BORDER="0" + SRC="img48.png" + ALT="$nrm2$"> + - + + - + + - - + + + - - + + +
        $A$$x$ Function
        Short Precision Realpsb_spnrmiShort Precision Realpsb_genrm2
        Long Precision Realpsb_spnrmiLong Precision Realpsb_genrm2
        Short Precision Complexpsb_spnrmi
        Short Precision RealShort Precision Complexpsb_genrm2
        Long Precision Complexpsb_spnrmi
        Long Precision RealLong Precision Complexpsb_genrm2
        @@ -126,7 +145,7 @@ Data types

        -psb_spnrmi(A, desc_a, info)
        +psb_genrm2(x, desc_a, info)
         

        @@ -137,20 +156,22 @@ psb_spnrmi(A, desc_a, info)

        On Entry
        -
        a
        -
        the local portion of the global sparse matrix +
        x
        +
        the local portion of global dense matrix $A$. + WIDTH="13" HEIGHT="14" ALIGN="BOTTOM" BORDER="0" + SRC="img28.png" + ALT="$x$">.
        Scope: local
        -Type: required +Type: required
        Intent: in.
        -Specified as: a structured data of type spdatapsb_spmat_type. +Specified as: a rank one or two array +containing numbers of type specified in +Table 8.
        desc_a
        contains data structures for communications. @@ -162,18 +183,22 @@ Type: required Intent: in.
        Specified as: a structured data of type descdatapsb_desc_type. + +

        On Return
        -
        Function value
        -
        is the infinity-norm of sparse submatrix $A$. +
        Function Value
        +
        is the 2-norm of subvector $x$.
        Scope: global
        +Type: required +
        Specified as: a long precision real number.
        info
        @@ -192,26 +217,26 @@ An integer value; 0 means no error has been detected.


        - next - + up - previous - contents
        - Next: psb_spmm Sparse - Up: Computational routines - Previous: psb_genrm2s Generalized -   Next: psb_genrm2s Generalized + Up: Computational routines + Previous: psb_geasums Generalized +   Contents diff --git a/docs/html/node36.html b/docs/html/node36.html index feb193155..e034a8bdc 100644 --- a/docs/html/node36.html +++ b/docs/html/node36.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_spmm -- Sparse Matrix by Dense Matrix Product - +psb_genrm2s -- Generalized 2-Norm of Vector + @@ -20,179 +20,102 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_spsm Triangular - Up: Computational routines - Previous: psb_spnrmi Infinity -   Next: psb_spnrmi Infinity + Up: Computational routines + Previous: psb_genrm2 2-Norm +   Contents

        -

        -psb_spmm -- Sparse Matrix by Dense Matrix Product +

        +psb_genrm2s -- Generalized 2-Norm of Vector

        -This subroutine computes the Sparse Matrix by Dense Matrix Product: - -

        -
        -

        - - - - - -
        \begin{displaymath}
-y \leftarrow \alpha P_r A P_c x + \beta y
-\end{displaymath} -(1)
        -

        -
        -
        - - - - - -
        \begin{displaymath}
-y \leftarrow \alpha P_r A^T P_c x + \beta y
-\end{displaymath} -(2)
        -

        -
        -
        - - - - - -
        \begin{displaymath}
-y \leftarrow \alpha P_r A^H P_c x + \beta y
-\end{displaymath} -(3)
        -

        - -

        -where: -

        -
        $x$
        -
        is the global dense submatrix $x_{:, :}$ -
        -
        $y$
        -
        is the global dense submatrix $y_{:, :}$ -
        -
        $A$
        -
        is the global sparse submatrix $A$ -
        -
        $P_r, P_c$
        -
        are the permutation matrices. -
        -
        + ALT="$x$">: +

        +
        + + +\begin{displaymath}res(i) \leftarrow \Vert x(:,i)\Vert _2 \end{displaymath} +
        +
        +

        + +

        +

        +call psb_genrm2s(res, x, desc_a, info)
        +


        -
        +
        -
        Table 11: +Table 9: Data types
        + + ALT="$x$"> - + + - + + - - + + + - - + + +
        $A$, $x$, $res$$y$, $\alpha$, $\beta$ Subroutine
        Short Precision Realpsb_spmmShort Precision Realpsb_genrm2s
        Long Precision Realpsb_spmmLong Precision Realpsb_genrm2s
        Short Precision Complexpsb_spmm
        Short Precision RealShort Precision Complexpsb_genrm2s
        Long Precision Complexpsb_spmm
        Long Precision RealLong Precision Complexpsb_genrm2s
        @@ -201,13 +124,6 @@ Data types


        -

        -

        -call psb_spmm(alpha, a, x, beta, y, desc_a, info)
        -call psb_spmm(alpha, a, x, beta, y,desc_a, info, &
        -             & trans, work)
        -
        -

        Type:
        @@ -216,41 +132,11 @@ call psb_spmm(alpha, a, x, beta, y,desc_a, info, &
        On Entry
        -
        alpha
        -
        the scalar $\alpha$. -
        -Scope: global -
        -Type: required -
        -Intent: in. -
        -Specified as: a number of the data type indicated in -Table 11. -
        -
        a
        -
        the local portion of the sparse matrix -$A$. -
        -Scope: local -
        -Type: required -
        -Intent: in. -
        -Specified as: a structured data of type spdatapsb_spmat_type. -
        x
        the local portion of global dense matrix $x$.
        @@ -260,53 +146,9 @@ Type: required
        Intent: in.
        -Specified as: a rank one or two array +Specified as: a rank one or two array containing numbers of type specified in -Table 11. The rank of $x$ must be the same of $y$. -
        -
        beta
        -
        the scalar $\beta$. -
        -Scope: global -
        -Type: required -
        -Intent: in. -
        -Specified as: a number of the data type indicated in Table 11. -
        -
        y
        -
        the local portion of global dense matrix -$y$. - -
        -Scope: local -
        -Type: required -
        -Intent: inout. -
        -Specified as: a rank one or two array -containing numbers of type specified in -Table 11. The rank of $y$ must be the same of $x$. +Table 9.
        desc_a
        contains data structures for communications. @@ -318,75 +160,23 @@ Type: required Intent: in.
        Specified as: a structured data of type descdatapsb_desc_type. -
        -
        trans
        -
        indicate what kind of operation to perform. -
        -
        trans = N
        -
        the operation is specified by equation 1 -
        -
        trans = T
        -
        the operation is specified by equation -2 -
        -
        trans = C
        -
        the operation is specified by equation -3 -
        -
        -Scope: global -
        -Type: optional -
        -Intent: in. -
        -Default: $trans = N$ -
        -Specified as: a character variable. - -

        -

        -
        work
        -
        work array. -
        -Scope: local -
        -Type: optional -
        -Intent: inout. -
        -Specified as: a rank one array of the same type of $x$ and $y$ with -the TARGET attribute.

        On Return
        -
        y
        -
        the local portion of result submatrix res +
        contains the 1-norm of (the columns of) $y$. + ALT="$x$">.
        -Scope: local +Scope: global
        -Type: required +Intent: out.
        -Intent: inout. -
        -Specified as: an array of rank one or two -containing numbers of type specified in -Table 11. +Specified as: a long precision real number.
        info
        Error code. @@ -404,26 +194,26 @@ An integer value; 0 means no error has been detected.


        - next - + up - previous - contents
        - Next: psb_spsm Triangular - Up: Computational routines - Previous: psb_spnrmi Infinity -   Next: psb_spnrmi Infinity + Up: Computational routines + Previous: psb_genrm2 2-Norm +   Contents diff --git a/docs/html/node37.html b/docs/html/node37.html index 018a95268..326b45d27 100644 --- a/docs/html/node37.html +++ b/docs/html/node37.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_spsm -- Triangular System Solve - +psb_spnrmi -- Infinity Norm of Sparse Matrix + @@ -18,164 +18,104 @@ original version by: Nikos Drakos, CBLU, University of Leeds + - + - next - + up - previous - contents
        - Next: Communication routines - Up: Computational routines - Previous: psb_spmm Sparse -   Next: psb_spmm Sparse + Up: Computational routines + Previous: psb_genrm2s Generalized +   Contents

        -

        -psb_spsm -- Triangular System Solve +

        +psb_spnrmi -- Infinity Norm of Sparse Matrix

        -This subroutine computes the Triangular System Solve: - +This function computes the infinity-norm of a matrix $A$: +

        -

        +

        -\begin{eqnarray*}
-y &\leftarrow& \alpha P_r T^{-1} P_c x + \beta y\\
-y &\leftar...
-...\beta y\\
-y &\leftarrow& \alpha P_r T^{-H} P_c D x + \beta y\\
-\end{eqnarray*}
        -

        -

        +\begin{displaymath}nrmi \leftarrow \Vert A\Vert _\infty \end{displaymath} + +
        +

        where:
        $x$
        -
        is the global dense submatrix $x_{:, :}$ -
        -
        $y$
        -
        is the global dense submatrix $y_{:, :}$ -
        -
        $T$
        -
        is the global sparse block triangular submatrix $T$ -
        -
        $D$
        -
        is the scaling diagonal matrix. -
        -
        $P_r, P_c$
        -
        are the permutation matrices. + WIDTH="16" HEIGHT="14" ALIGN="BOTTOM" BORDER="0" + SRC="img1.png" + ALT="$A$"> +
        represents the global matrix $A$
        -

        -

        -call psb_spsm(alpha, t, x, beta, y, desc_a, info)
        -call psb_spsm(alpha, t, x, beta, y, desc_a, info,&
        -             & trans, unit, choice, diag, work)
        -
        -


        -
        +
        -
        Table 12: +Table 10: Data types
        - + WIDTH="16" HEIGHT="14" ALIGN="BOTTOM" BORDER="0" + SRC="img1.png" + ALT="$A$"> + - + - + - + - +
        $T$, $x$, $y$, $D$, $\alpha$, $\beta$SubroutineFunction
        Short Precision Realpsb_spsmpsb_spnrmi
        Long Precision Realpsb_spsmpsb_spnrmi
        Short Precision Complexpsb_spsmpsb_spnrmi
        Long Precision Complexpsb_spsmpsb_spnrmi
        @@ -184,6 +124,11 @@ Data types


        +

        +

        +psb_spnrmi(A, desc_a, info)
        +
        +

        Type:
        @@ -192,27 +137,12 @@ Data types
        On Entry
        -
        alpha
        -
        the scalar $\alpha$. -
        -Scope: global -
        -Type: required -
        -Intent: in. -
        -Specified as: a number of the data type indicated in -Table 12. -
        -
        t
        -
        the global portion of the sparse matrix +
        a
        +
        the local portion of the global sparse matrix $T$. + WIDTH="16" HEIGHT="14" ALIGN="BOTTOM" BORDER="0" + SRC="img1.png" + ALT="$A$">.
        Scope: local
        @@ -220,70 +150,7 @@ Type: required
        Intent: in.
        -Specified as: a structured data type specified in -§ 3. -
        -
        x
        -
        the local portion of global dense matrix -$x$. - -
        -Scope: local -
        -Type: required -
        -Intent: in. -
        -Specified as: a rank one or two array -containing numbers of type specified in -Table 12. The rank of $x$ must be the same of $y$. -
        -
        beta
        -
        the scalar $\beta$. -
        -Scope: global -
        -Type: required -
        -Intent: in. -
        -Specified as: a number of the data type indicated in Table 12. -
        -
        y
        -
        the local portion of global dense matrix -$y$. - -
        -Scope: local -
        -Type: required -
        -Intent: inout. -
        -Specified as: a rank one or two array -containing numbers of type specified in -Table 12. The rank of $y$ must be the same of $x$. +Specified as: a structured data of type spdatapsb_spmat_type.
        desc_a
        contains data structures for communications. @@ -296,142 +163,18 @@ Intent: in.
        Specified as: a structured data of type descdatapsb_desc_type.
        -
        trans
        -
        specify with unitd the operation to perform. -
        -
        trans = 'N'
        -
        the operation is with no transposed matrix -
        -
        trans = 'T'
        -
        the operation is with transposed matrix. -
        -
        trans = 'C'
        -
        the operation is with conjugate transposed matrix. -
        -
        -Scope: global -
        -Type: optional -
        -Intent: in. -
        -Default: $trans = N$ -
        -Specified as: a character variable. -
        -
        unitd
        -
        specify with trans the operation to perform. -
        -
        unitd = 'U'
        -
        the operation is with no scaling -
        -
        unitd = 'L'
        -
        the operation is with left scaling -
        -
        unitd = 'R'
        -
        the operation is with right scaling. -
        -
        -Scope: global -
        -Type: optional -
        -Intent: in. -
        -Default: $unitd = U$ -
        -Specified as: a character variable. -
        -
        choice
        -
        specifies the update of overlap elements to be performed - on exit: -
        -
        -
        psb_none_ -
        -
        -
        psb_sum_ -
        -
        -
        psb_avg_ -
        -
        -
        psb_square_root_ -
        -
        -Scope: global -
        -Type: optional -
        -Intent: in. -
        -Default: psb_avg_ -
        -Specified as: an integer variable. -
        -
        diag
        -
        the diagonal scaling matrix. -
        -Scope: local -
        -Type: optional -
        -Intent: in. -
        -Default: -$diag(1) = 1 (no scaling)$ -
        -Specified as: a rank one array containing numbers of the type -indicated in Table 12. -
        -
        work
        -
        a work array. -
        -Scope: local -
        -Type: optional -
        -Intent: inout. -
        -Specified as: a rank one array of the same type of $x$ with the -TARGET attribute. - -

        -

        On Return
        -
        y
        -
        the local portion of global dense matrix -$y$. - +
        Function value
        +
        is the infinity-norm of sparse submatrix $A$.
        -Scope: local +Scope: global
        -Type: required -
        -Intent: inout. -
        -Specified as: an array of rank one or two -containing numbers of type specified in -Table 12. +Specified as: a long precision real number.
        info
        Error code. @@ -449,26 +192,26 @@ An integer value; 0 means no error has been detected.


        - next - + up - previous - contents
        - Next: Communication routines - Up: Computational routines - Previous: psb_spmm Sparse -   Next: psb_spmm Sparse + Up: Computational routines + Previous: psb_genrm2s Generalized +   Contents diff --git a/docs/html/node38.html b/docs/html/node38.html index 80d44dc57..74307619e 100644 --- a/docs/html/node38.html +++ b/docs/html/node38.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -Communication routines - +psb_spmm -- Sparse Matrix by Dense Matrix Product + @@ -18,63 +18,414 @@ original version by: Nikos Drakos, CBLU, University of Leeds - - - + + + - next - + up - previous - contents
        - Next: psb_halo Halo - Up: userhtml - Previous: psb_spsm Triangular -   Next: psb_spsm Triangular + Up: Computational routines + Previous: psb_spnrmi Infinity +   Contents

        -

        -Communication routines -

        -The routines in this chapter implement various global communication operators -on vectors associated with a discretization mesh. For auxiliary communication -routines not tied to a discretization space see 6. +

        +psb_spmm -- Sparse Matrix by Dense Matrix Product +

        -


        - -Subsections +This subroutine computes the Sparse Matrix by Dense Matrix Product: - - -

        +

        +
        +

        + + + + + +
        \begin{displaymath}
+y \leftarrow \alpha P_r A P_c x + \beta y
+\end{displaymath} +(1)
        +

        +
        +
        + + + + + +
        \begin{displaymath}
+y \leftarrow \alpha P_r A^T P_c x + \beta y
+\end{displaymath} +(2)
        +

        +
        +
        + + + + + +
        \begin{displaymath}
+y \leftarrow \alpha P_r A^H P_c x + \beta y
+\end{displaymath} +(3)
        +

        + +

        +where: +

        +
        $x$
        +
        is the global dense submatrix $x_{:, :}$ +
        +
        $y$
        +
        is the global dense submatrix $y_{:, :}$ +
        +
        $A$
        +
        is the global sparse submatrix $A$ +
        +
        $P_r, P_c$
        +
        are the permutation matrices. +
        +
        + +

        +

        +
        + + + +
        Table 11: +Data types
        +
        + + + + + + + + + + + + + + + + +
        $A$, $x$, $y$, $\alpha$, $\beta$Subroutine
        Short Precision Realpsb_spmm
        Long Precision Realpsb_spmm
        Short Precision Complexpsb_spmm
        Long Precision Complexpsb_spmm
        +
        +
        +

        +
        + +

        +

        +call psb_spmm(alpha, a, x, beta, y, desc_a, info)
        +call psb_spmm(alpha, a, x, beta, y,desc_a, info, &
        +             & trans, work)
        +
        + +

        +

        +
        Type:
        +
        Synchronous. +
        +
        On Entry
        +
        +
        +
        alpha
        +
        the scalar $\alpha$. +
        +Scope: global +
        +Type: required +
        +Intent: in. +
        +Specified as: a number of the data type indicated in +Table 11. +
        +
        a
        +
        the local portion of the sparse matrix +$A$. +
        +Scope: local +
        +Type: required +
        +Intent: in. +
        +Specified as: a structured data of type spdatapsb_spmat_type. +
        +
        x
        +
        the local portion of global dense matrix +$x$. + +
        +Scope: local +
        +Type: required +
        +Intent: in. +
        +Specified as: a rank one or two array +containing numbers of type specified in +Table 11. The rank of $x$ must be the same of $y$. +
        +
        beta
        +
        the scalar $\beta$. +
        +Scope: global +
        +Type: required +
        +Intent: in. +
        +Specified as: a number of the data type indicated in Table 11. +
        +
        y
        +
        the local portion of global dense matrix +$y$. + +
        +Scope: local +
        +Type: required +
        +Intent: inout. +
        +Specified as: a rank one or two array +containing numbers of type specified in +Table 11. The rank of $y$ must be the same of $x$. +
        +
        desc_a
        +
        contains data structures for communications. +
        +Scope: local +
        +Type: required +
        +Intent: in. +
        +Specified as: a structured data of type descdatapsb_desc_type. +
        +
        trans
        +
        indicate what kind of operation to perform. +
        +
        trans = N
        +
        the operation is specified by equation 1 +
        +
        trans = T
        +
        the operation is specified by equation +2 +
        +
        trans = C
        +
        the operation is specified by equation +3 +
        +
        +Scope: global +
        +Type: optional +
        +Intent: in. +
        +Default: $trans = N$ +
        +Specified as: a character variable. + +

        +

        +
        work
        +
        work array. +
        +Scope: local +
        +Type: optional +
        +Intent: inout. +
        +Specified as: a rank one array of the same type of $x$ and $y$ with +the TARGET attribute. + +

        +

        +
        On Return
        +
        +
        +
        y
        +
        the local portion of result submatrix $y$. +
        +Scope: local +
        +Type: required +
        +Intent: inout. +
        +Specified as: an array of rank one or two +containing numbers of type specified in +Table 11. +
        +
        info
        +
        Error code. +
        +Scope: local +
        +Type: required +
        +Intent: out. +
        +An integer value; 0 means no error has been detected. +
        +
        + +

        +


        + + +next + +up + +previous + +contents +
        + Next: psb_spsm Triangular + Up: Computational routines + Previous: psb_spnrmi Infinity +   Contents + diff --git a/docs/html/node39.html b/docs/html/node39.html index 974ae6582..9d591ba6d 100644 --- a/docs/html/node39.html +++ b/docs/html/node39.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_halo -- Halo Data Communication - +psb_spsm -- Triangular System Solve + @@ -18,105 +18,164 @@ original version by: Nikos Drakos, CBLU, University of Leeds - - + - next - + up - previous - contents
        - Next: psb_ovrl Overlap - Up: Communication routines - Previous: Communication routines -   Next: Communication routines + Up: Computational routines + Previous: psb_spmm Sparse +   Contents

        -

        -psb_halo -- Halo Data Communication +

        +psb_spsm -- Triangular System Solve

        -These subroutines gathers the values of the halo -elements, and (optionally) scale the result: +This subroutine computes the Triangular System Solve:

        -

        +

        - \begin{displaymath}x \leftarrow \alpha x \end{displaymath} -
        -
        -

        + WIDTH="194" HEIGHT="239" BORDER="0" + SRC="img58.png" + ALT="\begin{eqnarray*} +y &\leftarrow& \alpha P_r T^{-1} P_c x + \beta y\\ +y &\leftar... +...\beta y\\ +y &\leftarrow& \alpha P_r T^{-H} P_c D x + \beta y\\ +\end{eqnarray*}"> +

        + +

        where:

        $x$
        -
        is a global dense submatrix. +
        is the global dense submatrix $x_{:, :}$ +
        +
        $y$
        +
        is the global dense submatrix $y_{:, :}$ +
        +
        $T$
        +
        is the global sparse block triangular submatrix $T$ +
        +
        $D$
        +
        is the scaling diagonal matrix. +
        +
        $P_r, P_c$
        +
        are the permutation matrices.
        +

        +

        +call psb_spsm(alpha, t, x, beta, y, desc_a, info)
        +call psb_spsm(alpha, t, x, beta, y, desc_a, info,&
        +             & trans, unit, choice, diag, work)
        +
        +


        -
        +
        -
        Table 13: +Table 12: Data types
        + WIDTH="14" HEIGHT="30" ALIGN="MIDDLE" BORDER="0" + SRC="img31.png" + ALT="$\beta$"> - - - - + - + - + - +
        $T$, $x$, $y$, $D$, $\alpha$, $x$ Subroutine
        Integerpsb_halo
        Short Precision Realpsb_halopsb_spsm
        Long Precision Realpsb_halopsb_spsm
        Short Precision Complexpsb_halopsb_spsm
        Long Precision Complexpsb_halopsb_spsm
        @@ -125,12 +184,6 @@ Data types


        -

        -

        -call psb_halo(x, desc_a, info)
        -call psb_halo(x, desc_a, info, alpha, work, data)
        -
        -

        Type:
        @@ -139,11 +192,82 @@ call psb_halo(x, desc_a, info, alpha, work, data)
        On Entry
        +
        alpha
        +
        the scalar $\alpha$. +
        +Scope: global +
        +Type: required +
        +Intent: in. +
        +Specified as: a number of the data type indicated in +Table 12. +
        +
        t
        +
        the global portion of the sparse matrix +$T$. +
        +Scope: local +
        +Type: required +
        +Intent: in. +
        +Specified as: a structured data type specified in +§ 3. +
        x
        -
        global dense matrix $x$. +
        the local portion of global dense matrix +$x$. + +
        +Scope: local +
        +Type: required +
        +Intent: in. +
        +Specified as: a rank one or two array +containing numbers of type specified in +Table 12. The rank of $x$ must be the same of $y$. +
        +
        beta
        +
        the scalar $\beta$. +
        +Scope: global +
        +Type: required +
        +Intent: in. +
        +Specified as: a number of the data type indicated in Table 12. +
        +
        y
        +
        the local portion of global dense matrix +$y$. +
        Scope: local
        @@ -151,9 +275,15 @@ Type: required
        Intent: inout.
        -Specified as: a rank one or two array with the TARGET attribute +Specified as: a rank one or two array containing numbers of type specified in -Table 13. +Table 12. The rank of $y$ must be the same of $x$.
        desc_a
        contains data structures for communications. @@ -166,27 +296,107 @@ Intent: in.
        Specified as: a structured data of type descdatapsb_desc_type.
        -
        alpha
        -
        the scalar $\alpha$. -
        +
        trans
        +
        specify with unitd the operation to perform. +
        +
        trans = 'N'
        +
        the operation is with no transposed matrix +
        +
        trans = 'T'
        +
        the operation is with transposed matrix. +
        +
        trans = 'C'
        +
        the operation is with conjugate transposed matrix. +
        +
        Scope: global
        -Type: optional +Type: optional
        Intent: in.
        Default: $alpha = 1 $ + WIDTH="79" HEIGHT="15" ALIGN="BOTTOM" BORDER="0" + SRC="img57.png" + ALT="$trans = N$">
        -Specified as: a number of the data type indicated in Table 13. +Specified as: a character variable. +
        +
        unitd
        +
        specify with trans the operation to perform. +
        +
        unitd = 'U'
        +
        the operation is with no scaling +
        +
        unitd = 'L'
        +
        the operation is with left scaling +
        +
        unitd = 'R'
        +
        the operation is with right scaling. +
        +
        +Scope: global +
        +Type: optional +
        +Intent: in. +
        +Default: $unitd = U$ +
        +Specified as: a character variable. +
        +
        choice
        +
        specifies the update of overlap elements to be performed + on exit: +
        +
        +
        psb_none_ +
        +
        +
        psb_sum_ +
        +
        +
        psb_avg_ +
        +
        +
        psb_square_root_ +
        +
        +Scope: global +
        +Type: optional +
        +Intent: in. +
        +Default: psb_avg_ +
        +Specified as: an integer variable. +
        +
        diag
        +
        the diagonal scaling matrix. +
        +Scope: local +
        +Type: optional +
        +Intent: in. +
        +Default: +$diag(1) = 1 (no scaling)$ +
        +Specified as: a rank one array containing numbers of the type +indicated in Table 12.
        work
        -
        the work array. +
        a work array.
        Scope: local
        @@ -195,32 +405,23 @@ Type: optional Intent: inout.
        Specified as: a rank one array of the same type of $x$ with the -POINTER attribute. -
        -
        data
        -
        index list selector. -
        -Scope: global -
        -Type: optional -
        -Specified as: an integer. Values:psb_comm_halo_,psb_comm_mov_, -psb_comm_ext_, default: psb_comm_halo_. Chooses the -index list on which to base the data exchange. +TARGET attribute.

        On Return
        -
        x
        -
        global dense result matrix $x$. +
        y
        +
        the local portion of global dense matrix +$y$. +
        Scope: local
        @@ -228,15 +429,12 @@ Type: required
        Intent: inout.
        -Returned as: a rank one or two array +Specified as: an array of rank one or two containing numbers of type specified in -Table 13. +Table 12.
        info
        -
        the local portion of result submatrix $y$. +
        Error code.
        Scope: local
        @@ -244,408 +442,33 @@ Type: required
        Intent: out.
        -An integer value that contains an error code. +An integer value; 0 means no error has been detected.
        -
        - - - -
        Figure 6: -Sample discretization mesh.
        -
        -\includegraphics[scale=0.45]{figures/try8x8.eps} - - -\rotatebox{-90}{\includegraphics[scale=0.45]{figures/try8x8}} - -
        -
        - -

        -Usage Example -Consider the discretization mesh depicted in fig. 6, -partitioned among two processes as shown by the dashed line; the data -distribution is such that each process will own 32 entries in the -index space, with a halo made of 8 entries placed at local indices 33 -through 40. If process 0 assigns an initial value of 1 to its entries -in the $x$ vector, and process 1 assigns a value of 2, then after a -call to psb_halo the contents of the local vectors will be the -following: -
        -

        - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
        -Process 0  -Process 1
        - I GLOB(I) X(I)   I GLOB(I) X(I)
        - 1 1 1.0   1 33 2.0
        - 2 2 1.0   2 34 2.0
        - 3 3 1.0   3 35 2.0
        - 4 4 1.0   4 36 2.0
        - 5 5 1.0   5 37 2.0
        - 6 6 1.0   6 38 2.0
        - 7 7 1.0   7 39 2.0
        - 8 8 1.0   8 40 2.0
        - 9 9 1.0   9 41 2.0
        - 10 10 1.0   10 42 2.0
        - 11 11 1.0   11 43 2.0
        - 12 12 1.0   12 44 2.0
        - 13 13 1.0   13 45 2.0
        - 14 14 1.0   14 46 2.0
        - 15 15 1.0   15 47 2.0
        - 16 16 1.0   16 48 2.0
        - 17 17 1.0   17 49 2.0
        - 18 18 1.0   18 50 2.0
        - 19 19 1.0   19 51 2.0
        - 20 20 1.0   20 52 2.0
        -21 21 1.0   21 53 2.0
        -22 22 1.0   22 54 2.0
        -23 23 1.0   23 55 2.0
        -24 24 1.0   24 56 2.0
        -25 25 1.0   25 57 2.0
        -26 26 1.0   26 58 2.0
        -27 27 1.0   27 59 2.0
        -28 28 1.0   28 60 2.0
        -29 29 1.0   29 61 2.0
        -30 30 1.0   30 62 2.0
        -31 31 1.0   31 63 2.0
        -32 32 1.0   32 64 2.0
        -33 33 2.0   33 25 1.0
        -34 34 2.0   34 26 1.0
        -35 35 2.0   35 27 1.0
        -36 36 2.0   36 28 1.0
        -37 37 2.0   37 29 1.0
        -38 38 2.0   38 30 1.0
        -39 39 2.0   39 31 1.0
        -40 40 2.0   40 32 1.0
        -
        -


        - next - + up - previous - contents
        - Next: psb_ovrl Overlap - Up: Communication routines - Previous: Communication routines -   Next: Communication routines + Up: Computational routines + Previous: psb_spmm Sparse +   Contents diff --git a/docs/html/node4.html b/docs/html/node4.html index 73c2497ff..9d4cf0f85 100644 --- a/docs/html/node4.html +++ b/docs/html/node4.html @@ -26,26 +26,26 @@ original version by: Nikos Drakos, CBLU, University of Leeds - next - up - previous - contents
        - Next: Next: Library contents - Up: Up: General overview - Previous: Previous: General overview -   Contents

        @@ -126,8 +126,8 @@ Overlap points do not usually exist in the basic data distributions; however they are a feature of Domain Decomposition Schwarz preconditioners which are the subject of related research work [3,2]. + HREF="node108.html#2007c">3,2].

        We denote the sets of internal, boundary and halo points for a given @@ -135,7 +135,7 @@ subdomain by $\cal I$, $\cal B$ and

        \includegraphics[scale=0.65]{figures/points.eps} - next - up - previous - contents
        - Next: Next: Library contents - Up: Up: General overview - Previous: Previous: General overview -   Contents diff --git a/docs/html/node40.html b/docs/html/node40.html index 258c604f9..fbf7720ac 100644 --- a/docs/html/node40.html +++ b/docs/html/node40.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_ovrl -- Overlap Update - +Communication routines + @@ -18,744 +18,63 @@ original version by: Nikos Drakos, CBLU, University of Leeds - - - + + + - next - + up - previous - contents
        - Next: psb_gather Gather - Up: Communication routines - Previous: psb_halo Halo -   Next: psb_halo Halo + Up: userhtml + Previous: psb_spsm Triangular +   Contents

        -

        -psb_ovrl -- Overlap Update -

        +

        +Communication routines +

        +The routines in this chapter implement various global communication operators +on vectors associated with a discretization mesh. For auxiliary communication +routines not tied to a discretization space see 6.

        -These subroutines applies an overlap operator to the input vector: +


        + +Subsections -

        -

        -
        - - -\begin{displaymath}x \leftarrow Q x \end{displaymath} -
        -
        -

        -where: -
        -
        $x$
        -
        is the global dense submatrix $x$ -
        -
        $Q$
        -
        is the overlap operator; it is the composition of two -operators $ P_a$ and $ P^{T}$. -
        -
        - -

        -

        -
        - - - -
        Table 14: -Data types
        -
        - - - - - - - - - - - - - - - - -
        $x$Subroutine
        Short Precision Realpsb_ovrl
        Long Precision Realpsb_ovrl
        Short Precision Complexpsb_ovrl
        Long Precision Complexpsb_ovrl
        -
        -
        -

        -
        - -

        -

        -call psb_ovrl(x, desc_a, info)
        -call psb_ovrl(x, desc_a, info, update=update_type, work=work)
        -
        - -

        -

        -
        Type:
        -
        Synchronous. -
        -
        On Entry
        -
        -
        -
        x
        -
        global dense matrix $x$. -
        -Scope: local -
        -Type: required -
        -Intent: inout. -
        -Specified as: a rank one or two array -containing numbers of type specified in -Table 14. -
        -
        desc_a
        -
        contains data structures for communications. -
        -Scope: local -
        -Type: required -
        -Intent: in. -
        -Specified as: a structured data of type descdatapsb_desc_type. -
        -
        update
        -
        Update operator. -
        -
        update = psb_none_
        -
        Do nothing; -
        -
        update = psb_add_
        -
        Sum overlap entries, i.e. apply $P^T$; -
        -
        update = psb_avg_
        -
        Average overlap entries, i.e. apply $P_aP^T$; -
        -
        -Scope: global -
        -Intent: in. -
        -Default: -$update\_type = psb\_avg\_ $ -
        -Scope: global -
        -Specified as: a integer variable. -
        -
        work
        -
        the work array. -
        -Scope: local -
        -Type: optional -
        -Intent: inout. -
        -Specified as: a one dimensional array of the same type of $x$. - -

        -

        -
        On Return
        -
        -
        -
        x
        -
        global dense result matrix $x$. -
        -Scope: local -
        -Type: required -
        -Intent: inout. -
        -Specified as: an array of rank one or two -containing numbers of type specified in -Table 14. -
        -
        info
        -
        Error code. -
        -Scope: local -
        -Type: required -
        -Intent: out. -
        -An integer value; 0 means no error has been detected. -
        -
        - -

        -Notes - -

          -
        1. If there is no overlap in the data distribution associated with - the descriptor, no operations are performed; -
        2. -
        3. The operator $ P^{T}$ performs the reduction sum of overlap -elements; it is a ``prolongation'' operator $P^T$ that -replicates overlap elements, accounting for the physical replication -of data; -
        4. -
        5. The operator $ P_a$ performs a scaling on the overlap elements by -the amount of replication; thus, when combined with the reduction -operator, it implements the average of replicated elements over all of -their instances. -
        6. -
        - -

        - -

        - - - -
        Figure 7: -Sample discretization mesh.
        -
        -\includegraphics[scale=0.65]{figures/try8x8_ov.eps} - - -\rotatebox{-90}{\includegraphics[scale=0.65]{figures/try8x8_ov}} - -
        -
        - -Example of use -Consider the discretization mesh depicted in fig. 7, -partitioned among two processes as shown by the dashed lines, with an -overlap of 1 extra layer with respect to the partition of -fig. 6; the data -distribution is such that each process will own 40 entries in the -index space, with an overlap of 16 entries placed at local indices 25 -through 40; the halo will run from local index 41 through local index 48.. If process 0 assigns an initial value of 1 to its entries -in the $x$ vector, and process 1 assigns a value of 2, then after a -call to psb_ovrl with psb_avg_ and a call to -psb_halo_ the contents of the local vectors will be the -following (showing a transition among the two subdomains) - -

        -
        -

        - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
        -Process 0  -Process 1
        - I GLOB(I) X(I)   I GLOB(I) X(I)
        - 1 1 1.0   1 33 1.5
        - 2 2 1.0   2 34 1.5
        - 3 3 1.0   3 35 1.5
        - 4 4 1.0   4 36 1.5
        - 5 5 1.0   5 37 1.5
        - 6 6 1.0   6 38 1.5
        - 7 7 1.0   7 39 1.5
        - 8 8 1.0   8 40 1.5
        - 9 9 1.0   9 41 2.0
        - 10 10 1.0   10 42 2.0
        - 11 11 1.0   11 43 2.0
        - 12 12 1.0   12 44 2.0
        - 13 13 1.0   13 45 2.0
        - 14 14 1.0   14 46 2.0
        - 15 15 1.0   15 47 2.0
        - 16 16 1.0   16 48 2.0
        - 17 17 1.0   17 49 2.0
        - 18 18 1.0   18 50 2.0
        - 19 19 1.0   19 51 2.0
        - 20 20 1.0   20 52 2.0
        - 21 21 1.0   21 53 2.0
        - 22 22 1.0   22 54 2.0
        - 23 23 1.0   23 55 2.0
        - 24 24 1.0   24 56 2.0
        - 25 25 1.5   25 57 2.0
        - 26 26 1.5   26 58 2.0
        - 27 27 1.5   27 59 2.0
        - 28 28 1.5   28 60 2.0
        - 29 29 1.5   29 61 2.0
        - 30 30 1.5   30 62 2.0
        - 31 31 1.5   31 63 2.0
        - 32 32 1.5   32 64 2.0
        - 33 33 1.5   33 25 1.5
        - 34 34 1.5   34 26 1.5
        - 35 35 1.5   35 27 1.5
        - 36 36 1.5   36 28 1.5
        - 37 37 1.5   37 29 1.5
        - 38 38 1.5   38 30 1.5
        - 39 39 1.5   39 31 1.5
        - 40 40 1.5   40 32 1.5
        - 41 41 2.0   41 17 1.0
        - 42 42 2.0   42 18 1.0
        - 43 43 2.0   43 19 1.0
        - 44 44 2.0   44 20 1.0
        - 45 45 2.0   45 21 1.0
        - 46 46 2.0   46 22 1.0
        - 47 47 2.0   47 23 1.0
        - 48 48 2.0   48 24 1.0
        -
        - -

        -


        - - -next - -up - -previous - -contents -
        - Next: psb_gather Gather - Up: Communication routines - Previous: psb_halo Halo -   Contents - + + +

        diff --git a/docs/html/node41.html b/docs/html/node41.html index ee9a6d5ab..f44da86ef 100644 --- a/docs/html/node41.html +++ b/docs/html/node41.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_gather -- Gather Global Dense Matrix - +psb_halo -- Halo Data Communication + @@ -20,123 +20,103 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_scatter Scatter - Up: Communication routines - Previous: psb_ovrl Overlap -   Next: psb_ovrl Overlap + Up: Communication routines + Previous: Communication routines +   Contents

        -

        -psb_gather -- Gather Global Dense Matrix +

        +psb_halo -- Halo Data Communication

        -These subroutines collect the portions of global dense matrix -distributed over all process into one single array stored on one -process. +These subroutines gathers the values of the halo +elements, and (optionally) scale the result:


        \begin{displaymath}glob\_x \leftarrow collect(loc\_x_i) \end{displaymath} + WIDTH="53" HEIGHT="24" BORDER="0" + SRC="img63.png" + ALT="\begin{displaymath}x \leftarrow \alpha x \end{displaymath}">

        where:
        $glob\_x$
        -
        is the global submatrix -$glob\_x_{1:m,1:n}$ -
        -
        $loc\_x_i$
        -
        is the local portion of global dense matrix on -process $i$. -
        -
        $collect$
        -
        is the collect function. + WIDTH="13" HEIGHT="14" ALIGN="BOTTOM" BORDER="0" + SRC="img28.png" + ALT="$x$"> +
        is a global dense submatrix.


        -
        +
        -
        Table 15: +Table 13: Data types
        + WIDTH="14" HEIGHT="14" ALIGN="BOTTOM" BORDER="0" + SRC="img30.png" + ALT="$\alpha$">, $x$ - + - + - + - + - +
        $x_i, y$ Subroutine
        Integerpsb_gatherpsb_halo
        Short Precision Realpsb_gatherpsb_halo
        Long Precision Realpsb_gatherpsb_halo
        Short Precision Complexpsb_gatherpsb_halo
        Long Precision Complexpsb_gatherpsb_halo
        @@ -147,8 +127,8 @@ Data types

        -call psb_gather(glob_x, loc_x, desc_a, info, root)
        -call psb_gather(glob_x, loc_x, desc_a, info, root)
        +call psb_halo(x, desc_a, info)
        +call psb_halo(x, desc_a, info, alpha, work, data)
         

        @@ -159,21 +139,21 @@ call psb_gather(glob_x, loc_x, desc_a, info, root)

        On Entry
        -
        loc_x
        -
        the local portion of global dense matrix -$glob\_x$. +
        x
        +
        global dense matrix $x$.
        Scope: local
        -Type: required +Type: required
        -Intent: in. +Intent: inout.
        -Specified as: a rank one or two array containing numbers of the type -indicated in Table 15. +Specified as: a rank one or two array with the TARGET attribute +containing numbers of type specified in +Table 13.
        desc_a
        contains data structures for communications. @@ -186,46 +166,77 @@ Intent: in.
        Specified as: a structured data of type descdatapsb_desc_type.
        -
        root
        -
        The process that holds the global copy. If $root=-1$ all - the processes will have a copy of the global vector. +
        alpha
        +
        the scalar $\alpha$.
        Scope: global
        -Type: optional +Type: optional
        Intent: in.
        -Specified as: an integer variable -$-1\le root\le np-1$, default $-1$. +Default: $alpha = 1 $ +
        +Specified as: a number of the data type indicated in Table 13. +
        +
        work
        +
        the work array. +
        +Scope: local +
        +Type: optional +
        +Intent: inout. +
        +Specified as: a rank one array of the same type of $x$ with the +POINTER attribute. +
        +
        data
        +
        index list selector. +
        +Scope: global +
        +Type: optional +
        +Specified as: an integer. Values:psb_comm_halo_,psb_comm_mov_, +psb_comm_ext_, default: psb_comm_halo_. Chooses the +index list on which to base the data exchange. + +

        On Return
        -
        glob_x
        -
        The array where the local parts must be gathered. +
        x
        +
        global dense result matrix $x$.
        -Scope: global +Scope: local
        -Type: required +Type: required
        -Intent: out. +Intent: inout.
        -Specified as: a rank one or two array. +Returned as: a rank one or two array +containing numbers of type specified in +Table 13.
        info
        -
        Error code. +
        the local portion of result submatrix $y$.
        Scope: local
        @@ -233,33 +244,408 @@ Type: required
        Intent: out.
        -An integer value; 0 means no error has been detected. +An integer value that contains an error code.
        +
        + + + +
        Figure 7: +Sample discretization mesh.
        +
        +\includegraphics[scale=0.45]{figures/try8x8.eps} + + +\rotatebox{-90}{\includegraphics[scale=0.45]{figures/try8x8}} + +
        +
        + +

        +Usage Example +Consider the discretization mesh depicted in fig. 7, +partitioned among two processes as shown by the dashed line; the data +distribution is such that each process will own 32 entries in the +index space, with a halo made of 8 entries placed at local indices 33 +through 40. If process 0 assigns an initial value of 1 to its entries +in the $x$ vector, and process 1 assigns a value of 2, then after a +call to psb_halo the contents of the local vectors will be the +following: +
        +

        + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
        +Process 0  +Process 1
        + I GLOB(I) X(I)   I GLOB(I) X(I)
        + 1 1 1.0   1 33 2.0
        + 2 2 1.0   2 34 2.0
        + 3 3 1.0   3 35 2.0
        + 4 4 1.0   4 36 2.0
        + 5 5 1.0   5 37 2.0
        + 6 6 1.0   6 38 2.0
        + 7 7 1.0   7 39 2.0
        + 8 8 1.0   8 40 2.0
        + 9 9 1.0   9 41 2.0
        + 10 10 1.0   10 42 2.0
        + 11 11 1.0   11 43 2.0
        + 12 12 1.0   12 44 2.0
        + 13 13 1.0   13 45 2.0
        + 14 14 1.0   14 46 2.0
        + 15 15 1.0   15 47 2.0
        + 16 16 1.0   16 48 2.0
        + 17 17 1.0   17 49 2.0
        + 18 18 1.0   18 50 2.0
        + 19 19 1.0   19 51 2.0
        + 20 20 1.0   20 52 2.0
        +21 21 1.0   21 53 2.0
        +22 22 1.0   22 54 2.0
        +23 23 1.0   23 55 2.0
        +24 24 1.0   24 56 2.0
        +25 25 1.0   25 57 2.0
        +26 26 1.0   26 58 2.0
        +27 27 1.0   27 59 2.0
        +28 28 1.0   28 60 2.0
        +29 29 1.0   29 61 2.0
        +30 30 1.0   30 62 2.0
        +31 31 1.0   31 63 2.0
        +32 32 1.0   32 64 2.0
        +33 33 2.0   33 25 1.0
        +34 34 2.0   34 26 1.0
        +35 35 2.0   35 27 1.0
        +36 36 2.0   36 28 1.0
        +37 37 2.0   37 29 1.0
        +38 38 2.0   38 30 1.0
        +39 39 2.0   39 31 1.0
        +40 40 2.0   40 32 1.0
        +
        +


        - next - + up - previous - contents
        - Next: psb_scatter Scatter - Up: Communication routines - Previous: psb_ovrl Overlap -   Next: psb_ovrl Overlap + Up: Communication routines + Previous: Communication routines +   Contents diff --git a/docs/html/node42.html b/docs/html/node42.html index d50ddc233..d1acca8bc 100644 --- a/docs/html/node42.html +++ b/docs/html/node42.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_scatter -- Scatter Global Dense Matrix - +psb_ovrl -- Overlap Update + @@ -18,123 +18,114 @@ original version by: Nikos Drakos, CBLU, University of Leeds + - + - next - + up - previous - contents
        - Next: Data management routines - Up: Communication routines - Previous: psb_gather Gather -   Next: psb_gather Gather + Up: Communication routines + Previous: psb_halo Halo +   Contents

        -

        -psb_scatter -- Scatter Global Dense Matrix +

        +psb_ovrl -- Overlap Update

        -These subroutines scatters the portions of global dense matrix owned -by a process to all the processes in the processes grid. +These subroutines applies an overlap operator to the input vector:


        \begin{displaymath}loc\_x_i \leftarrow scatter(glob\_x) \end{displaymath} + WIDTH="55" HEIGHT="27" BORDER="0" + SRC="img67.png" + ALT="\begin{displaymath}x \leftarrow Q x \end{displaymath}">

        where:
        $glob\_x$
        -
        is the global matrix -$glob\_x_{1:m,1:n}$ + WIDTH="13" HEIGHT="14" ALIGN="BOTTOM" BORDER="0" + SRC="img28.png" + ALT="$x$"> +
        is the global dense submatrix $x$
        $loc\_x_i$
        -
        is the local portion of global dense matrix on -process $i$. -
        -
        $scatter$
        -
        is the scatter function. + WIDTH="16" HEIGHT="30" ALIGN="MIDDLE" BORDER="0" + SRC="img68.png" + ALT="$Q$"> +
        is the overlap operator; it is the composition of two +operators $ P_a$ and $ P^{T}$.


        -
        +
        -
        Table 16: +Table 14: Data types
        + WIDTH="13" HEIGHT="14" ALIGN="BOTTOM" BORDER="0" + SRC="img28.png" + ALT="$x$"> - - - - + - + - + - +
        $x_i, y$ Subroutine
        Integerpsb_scatter
        Short Precision Realpsb_scatterpsb_ovrl
        Long Precision Realpsb_scatterpsb_ovrl
        Short Precision Complexpsb_scatterpsb_ovrl
        Long Precision Complexpsb_scatterpsb_ovrl
        @@ -145,9 +136,9 @@ Data types

        -call psb_scatter(glob_x, loc_x, desc_a, info, root)
        -call psb_scatter(glob_x, loc_x, desc_a, info, root)
        -
        +call psb_ovrl(x, desc_a, info) +call psb_ovrl(x, desc_a, info, update=update_type, work=work) +

        @@ -157,16 +148,21 @@ call psb_scatter(glob_x, loc_x, desc_a, info, root)
        On Entry
        -
        glob_x
        -
        The array that must be scattered into local pieces. +
        x
        +
        global dense matrix $x$.
        -Scope: global +Scope: local
        -Type: required +Type: required
        -Intent: in. +Intent: inout.
        -Specified as: a rank one or two array. +Specified as: a rank one or two array +containing numbers of type specified in +Table 14.
        desc_a
        contains data structures for communications. @@ -179,48 +175,75 @@ Intent: in.
        Specified as: a structured data of type descdatapsb_desc_type.
        -
        root
        -
        The process that holds the global copy. If $root=-1$ all - the processes have a copy of the global vector. -
        +
        update
        +
        Update operator. +
        +
        update = psb_none_
        +
        Do nothing; +
        +
        update = psb_add_
        +
        Sum overlap entries, i.e. apply $P^T$; +
        +
        update = psb_avg_
        +
        Average overlap entries, i.e. apply $P_aP^T$; +
        +
        Scope: global
        -Type: optional -
        Intent: in.
        -Specified as: an integer variable $-1\le root\le np-1$, default $-1$. + WIDTH="166" HEIGHT="30" ALIGN="MIDDLE" BORDER="0" + SRC="img73.png" + ALT="$update\_type = psb\_avg\_ $"> +
        +Scope: global +
        +Specified as: a integer variable. +
        +
        work
        +
        the work array. +
        +Scope: local +
        +Type: optional +
        +Intent: inout. +
        +Specified as: a one dimensional array of the same type of $x$. + +

        On Return
        -
        loc_x
        -
        the local portion of global dense matrix -$glob\_x$. +
        x
        +
        global dense result matrix $x$.
        Scope: local
        -Type: required +Type: required
        -Intent: out. +Intent: inout.
        -Specified as: a rank one or two array containing numbers of the type -indicated in Table 16. +Specified as: an array of rank one or two +containing numbers of type specified in +Table 14.
        info
        Error code. @@ -235,29 +258,502 @@ An integer value; 0 means no error has been detected.
        +

        +Notes + +

          +
        1. If there is no overlap in the data distribution associated with + the descriptor, no operations are performed; +
        2. +
        3. The operator $ P^{T}$ performs the reduction sum of overlap +elements; it is a ``prolongation'' operator $P^T$ that +replicates overlap elements, accounting for the physical replication +of data; +
        4. +
        5. The operator $ P_a$ performs a scaling on the overlap elements by +the amount of replication; thus, when combined with the reduction +operator, it implements the average of replicated elements over all of +their instances. +
        6. +
        + +

        + +

        + + + +
        Figure 8: +Sample discretization mesh.
        +
        +\includegraphics[scale=0.65]{figures/try8x8_ov.eps} + + +\rotatebox{-90}{\includegraphics[scale=0.65]{figures/try8x8_ov}} + +
        +
        + +Example of use +Consider the discretization mesh depicted in fig. 8, +partitioned among two processes as shown by the dashed lines, with an +overlap of 1 extra layer with respect to the partition of +fig. 7; the data +distribution is such that each process will own 40 entries in the +index space, with an overlap of 16 entries placed at local indices 25 +through 40; the halo will run from local index 41 through local index 48.. If process 0 assigns an initial value of 1 to its entries +in the $x$ vector, and process 1 assigns a value of 2, then after a +call to psb_ovrl with psb_avg_ and a call to +psb_halo_ the contents of the local vectors will be the +following (showing a transition among the two subdomains) + +

        +
        +

        + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
        +Process 0  +Process 1
        + I GLOB(I) X(I)   I GLOB(I) X(I)
        + 1 1 1.0   1 33 1.5
        + 2 2 1.0   2 34 1.5
        + 3 3 1.0   3 35 1.5
        + 4 4 1.0   4 36 1.5
        + 5 5 1.0   5 37 1.5
        + 6 6 1.0   6 38 1.5
        + 7 7 1.0   7 39 1.5
        + 8 8 1.0   8 40 1.5
        + 9 9 1.0   9 41 2.0
        + 10 10 1.0   10 42 2.0
        + 11 11 1.0   11 43 2.0
        + 12 12 1.0   12 44 2.0
        + 13 13 1.0   13 45 2.0
        + 14 14 1.0   14 46 2.0
        + 15 15 1.0   15 47 2.0
        + 16 16 1.0   16 48 2.0
        + 17 17 1.0   17 49 2.0
        + 18 18 1.0   18 50 2.0
        + 19 19 1.0   19 51 2.0
        + 20 20 1.0   20 52 2.0
        + 21 21 1.0   21 53 2.0
        + 22 22 1.0   22 54 2.0
        + 23 23 1.0   23 55 2.0
        + 24 24 1.0   24 56 2.0
        + 25 25 1.5   25 57 2.0
        + 26 26 1.5   26 58 2.0
        + 27 27 1.5   27 59 2.0
        + 28 28 1.5   28 60 2.0
        + 29 29 1.5   29 61 2.0
        + 30 30 1.5   30 62 2.0
        + 31 31 1.5   31 63 2.0
        + 32 32 1.5   32 64 2.0
        + 33 33 1.5   33 25 1.5
        + 34 34 1.5   34 26 1.5
        + 35 35 1.5   35 27 1.5
        + 36 36 1.5   36 28 1.5
        + 37 37 1.5   37 29 1.5
        + 38 38 1.5   38 30 1.5
        + 39 39 1.5   39 31 1.5
        + 40 40 1.5   40 32 1.5
        + 41 41 2.0   41 17 1.0
        + 42 42 2.0   42 18 1.0
        + 43 43 2.0   43 19 1.0
        + 44 44 2.0   44 20 1.0
        + 45 45 2.0   45 21 1.0
        + 46 46 2.0   46 22 1.0
        + 47 47 2.0   47 23 1.0
        + 48 48 2.0   48 24 1.0
        +
        +


        - next - + up - previous - contents
        - Next: Data management routines - Up: Communication routines - Previous: psb_gather Gather -   Next: psb_gather Gather + Up: Communication routines + Previous: psb_halo Halo +   Contents diff --git a/docs/html/node43.html b/docs/html/node43.html index b422926e6..75c0bc5d4 100644 --- a/docs/html/node43.html +++ b/docs/html/node43.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -Data management routines - +psb_gather -- Gather Global Dense Matrix + @@ -18,114 +18,250 @@ original version by: Nikos Drakos, CBLU, University of Leeds - - - + + + - next - + up - previous - contents
        - Next: psb_cdall Allocates - Up: userhtml - Previous: psb_scatter Scatter -   Next: psb_scatter Scatter + Up: Communication routines + Previous: psb_ovrl Overlap +   Contents

        -

        - -
        -Data management routines -

        +

        +psb_gather -- Gather Global Dense Matrix +

        -


        - -Subsections +These subroutines collect the portions of global dense matrix +distributed over all process into one single array stored on one +process. - - -

        +

        +

        +
        + + +\begin{displaymath}glob\_x \leftarrow collect(loc\_x_i) \end{displaymath} +
        +
        +

        +where: +
        +
        $glob\_x$
        +
        is the global submatrix +$glob\_x_{1:m,1:n}$ +
        +
        $loc\_x_i$
        +
        is the local portion of global dense matrix on +process $i$. +
        +
        $collect$
        +
        is the collect function. +
        +
        + +

        +

        +
        + + + +
        Table 15: +Data types
        +
        + + + + + + + + + + + + + + + + + + + +
        $x_i, y$Subroutine
        Integerpsb_gather
        Short Precision Realpsb_gather
        Long Precision Realpsb_gather
        Short Precision Complexpsb_gather
        Long Precision Complexpsb_gather
        +
        +
        +

        +
        + +

        +

        +call psb_gather(glob_x, loc_x, desc_a, info, root)
        +call psb_gather(glob_x, loc_x, desc_a, info, root)
        +
        + +

        +

        +
        Type:
        +
        Synchronous. +
        +
        On Entry
        +
        +
        +
        loc_x
        +
        the local portion of global dense matrix +$glob\_x$. +
        +Scope: local +
        +Type: required +
        +Intent: in. +
        +Specified as: a rank one or two array containing numbers of the type +indicated in Table 15. +
        +
        desc_a
        +
        contains data structures for communications. +
        +Scope: local +
        +Type: required +
        +Intent: in. +
        +Specified as: a structured data of type descdatapsb_desc_type. +
        +
        root
        +
        The process that holds the global copy. If $root=-1$ all + the processes will have a copy of the global vector. +
        +Scope: global +
        +Type: optional +
        +Intent: in. +
        +Specified as: an integer variable +$-1\le root\le np-1$, default $-1$. +
        +
        On Return
        +
        +
        +
        glob_x
        +
        The array where the local parts must be gathered. +
        +Scope: global +
        +Type: required +
        +Intent: out. +
        +Specified as: a rank one or two array. +
        +
        info
        +
        Error code. +
        +Scope: local +
        +Type: required +
        +Intent: out. +
        +An integer value; 0 means no error has been detected. +
        +
        + +

        +


        + + +next + +up + +previous + +contents +
        + Next: psb_scatter Scatter + Up: Communication routines + Previous: psb_ovrl Overlap +   Contents + diff --git a/docs/html/node44.html b/docs/html/node44.html index dd2268b14..1a434cab3 100644 --- a/docs/html/node44.html +++ b/docs/html/node44.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_cdall -- Allocates a communication descriptor - +psb_scatter -- Scatter Global Dense Matrix + @@ -18,209 +18,209 @@ original version by: Nikos Drakos, CBLU, University of Leeds - - + - next - + up - previous - contents
        - Next: psb_cdins Communication - Up: Data management routines - Previous: Data management routines -   Next: Data management routines + Up: Communication routines + Previous: psb_gather Gather +   Contents

        -

        -psb_cdall -- Allocates a communication descriptor +

        +psb_scatter -- Scatter Global Dense Matrix

        -

        -call psb_cdall(icontxt, desc_a, info,mg=mg,parts=parts)
        -call psb_cdall(icontxt, desc_a, info,vg=vg,[mg=mg,flag=flag])
        -call psb_cdall(icontxt, desc_a, info,vl=vl,[nl=nl,globalcheck=.true.])
        -call psb_cdall(icontxt, desc_a, info,nl=nl)
        -call psb_cdall(icontxt, desc_a, info,mg=mg,repl=.true.)
        -
        +These subroutines scatters the portions of global dense matrix owned +by a process to all the processes in the processes grid.

        -This subroutine initializes the communication descriptor associated -with an index space. One of the optional arguments -parts, vg, vl, nl or repl -must be specified, thereby choosing -the specific initialization strategy. +

        +
        + + +\begin{displaymath}loc\_x_i \leftarrow scatter(glob\_x) \end{displaymath} +
        +
        +

        +where:
        -
        On Entry
        -
        -
        -
        Type:
        -
        Synchronous. -
        -
        icontxt
        -
        the communication context. -
        -Scope:global. -
        -Type:required. -
        -Intent: in. -
        -Specified as: an integer value. -
        -
        vg
        -
        Data allocation: each index $glob\_x_{1:m,1:n}$ +
        +
        $loc\_x_i$
        +
        is the local portion of global dense matrix on +process $i$. +
        +
        $i\in \{1\dots mg\}$ is allocated - to process $vg(i)$. -
        -Scope:global. -
        -Type:optional. -
        -Intent: in. -
        -Specified as: an integer array. - -
        flag
        -
        Specifies whether entries in $vg$ are zero- or one-based. -
        -Scope:global. -
        -Type:optional. -
        -Intent: in. -
        -Specified as: an integer value $0,1$, default $0$. - -

        -

        -
        mg
        -
        the (global) number of rows of the problem. -
        -Scope:global. -
        -Type:optional. -
        -Intent: in. -
        -Specified as: an integer value. It is required if parts or -repl is specified, it is optional if vg is specified. -
        -
        parts
        -
        the subroutine that defines the partitioning scheme. -
        -Scope:global. -
        -Type:required. -
        -Specified as: a subroutine. -
        -
        vl
        -
        Data allocation: the set of global indices - $vl(1:nl)$ belonging to the calling process. -
        -Scope:local. -
        -Type:optional. -
        -Intent: in. -
        -Specified as: an integer array. -
        -
        nl
        -
        Data allocation: in a generalized block-row distribution the - number of indices belonging to the current process. -
        -Scope:local. -
        -Type:optional. -
        -Intent: in. -
        -Specified as: an integer value. May be specified together with -vl. -
        -
        repl
        -
        Data allocation: build a replicated index space (i.e. all - processes own all indices). -
        -Scope:global. -
        -Type:optional. -
        -Intent: in. -
        -Specified as: the logical value .true. -
        -
        globalcheck
        -
        Data allocation: do global checks on the local - index lists vl -
        -Scope:global. -
        -Type:optional. -
        -Intent: in. -
        -Specified as: a logical value, default: .true. + ALT="$scatter$">
        +
        is the scatter function.
        +

        +

        +
        + + + +
        Table 16: +Data types
        +
        + + + + + + + + + + + + + + + + + + + +
        $x_i, y$Subroutine
        Integerpsb_scatter
        Short Precision Realpsb_scatter
        Long Precision Realpsb_scatter
        Short Precision Complexpsb_scatter
        Long Precision Complexpsb_scatter
        +
        +
        +

        +
        + +

        +

        +call psb_scatter(glob_x, loc_x, desc_a, info, root)
        +call psb_scatter(glob_x, loc_x, desc_a, info, root)
        +
        +

        +
        Type:
        +
        Synchronous. +
        +
        On Entry
        +
        +
        +
        glob_x
        +
        The array that must be scattered into local pieces. +
        +Scope: global +
        +Type: required +
        +Intent: in. +
        +Specified as: a rank one or two array. +
        +
        desc_a
        +
        contains data structures for communications. +
        +Scope: local +
        +Type: required +
        +Intent: in. +
        +Specified as: a structured data of type descdatapsb_desc_type. +
        +
        root
        +
        The process that holds the global copy. If $root=-1$ all + the processes have a copy of the global vector. +
        +Scope: global +
        +Type: optional +
        +Intent: in. +
        +Specified as: an integer variable +$-1\le root\le np-1$, default $-1$. +
        On Return
        -
        desc_a
        -
        the communication descriptor. +
        loc_x
        +
        the local portion of global dense matrix +$glob\_x$.
        -Scope:local. +Scope: local
        -Type:required. +Type: required
        Intent: out.
        -Specified as: a structured data of type descdatapsb_desc_type. +Specified as: a rank one or two array containing numbers of the type +indicated in Table 16.
        info
        Error code. @@ -235,188 +235,29 @@ An integer value; 0 means no error has been detected.
        -

        -Notes - -

          -
        1. One of the optional arguments parts, vg, - vl, nl or repl must be specified, thereby choosing the - initialization strategy as follows: -
          -
          parts
          -
          In this case we have a subroutine specifying the mapping - between global indices and process/local index pairs. If this - optional argument is specified, then it is mandatory to - specify the argument mg as well. - The subroutine must conform to the following interface: -
          -  interface 
          -     subroutine psb_parts(glob_index,mg,np,pv,nv)
          -       integer, intent (in)  :: glob_index,np,mg
          -       integer, intent (out) :: nv, pv(*)
          -     end subroutine psb_parts
          -  end interface
          -
          - The input arguments are: -
          -
          glob_index
          -
          The global index to be mapped; - -
          -
          np
          -
          The number of processes in the mapping; - -
          -
          mg
          -
          The total number of global rows in the mapping; - -
          -
          - The output arguments are: -
          -
          nv
          -
          The number of entries in pv; - -
          -
          pv
          -
          A vector containing the indices of the processes to - which the global index should be assigend; each entry must satisfy - -$0\le pv(i) < np$; if $nv>1$ we have an index assigned to multiple - processes, i.e. we have an overlap among the subdomains. - -
          -
          -
          -
          vg
          -
          In this case the association between an index and a process - is specified via an integer vector vg(1:mg); - each index -$i\in \{1\dots mg\}$ is assigned to process $vg(i)$. - The vector vg must be identical on all - calling processes; its entries may have the ranges $(0\dots np-1)$ - or $(1\dots np)$ according to the value of flag. - The size $mg$ may be specified via the optional argument mg; - the default is to use the entire vector vg, thus having - mg=size(vg). -
          -
          vl
          -
          In this case we are specifying the list of indices - vl(1:nl) assigned to the current process; thus, the global - problem size $mg$ is given by - the range of the aggregate of the individual vectors vl specified - in the calling processes. The size may be specified via the optional - argument nl; the default is to use the entire vector vl, thus having - nl=size(vl). - If globalcheck=.true. the subroutine will check how many - times each entry in the global index space $(1\dots mg)$ is - specified in the input lists vl, thus allowing for the - presence of overlap in the input, and checking for ``orphan'' - indices. If globalcheck=.false., the subroutine will not - check for overlap, and may be significantly faster, but the user - is implicitly guaranteeing that there are neither orphan nor - overlap indices. -
          -
          nl
          -
          If this argument is specified alone (i.e. without vl) - the result is a generalized row-block distribution in which each - process $I$ gets assigned a consecutive chunk of $N_I=nl$ global - indices. -
          -
          repl
          -
          This arguments specifies to replicate all indices on - all processes. This is a special purpose data allocation that is - useful in the construction of some multilevel preconditioners. -
          -
          -
        2. -
        3. On exit from this routine the descriptor is in the build - state. -
        4. -
        5. Calling the routine with vg or parts implies that - every process will scan the entire index space to figure out the - local indices. -
        6. -
        7. Overlapped indices are possible with both parts and - vl invocations. -
        8. -
        9. When the subroutine is invoked with vl in - conjunction with globalcheck=.true., it will perform a scan - of the index space to search for overlap or orphan indices. -
        10. -
        11. When the subroutine is invoked with vl in - conjunction with globalcheck=.false., no index space scan - will take place. Thus it is the responsibility of the user to make - sure that the indices specified in vl have neither orphans nor - overlaps; if this assumption fails, results will be - unpredictable. -
        12. -
        13. Orphan and overlap indices are - impossible by construction when the subroutine is invoked with - nl (alone), or vg. -
        14. -
        -


        - next - + up - previous - contents
        - Next: psb_cdins Communication - Up: Data management routines - Previous: Data management routines -   Next: Data management routines + Up: Communication routines + Previous: psb_gather Gather +   Contents diff --git a/docs/html/node45.html b/docs/html/node45.html index 6fe167d77..424b886cc 100644 --- a/docs/html/node45.html +++ b/docs/html/node45.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_cdins -- Communication descriptor insert routine - +Data management routines + @@ -18,168 +18,114 @@ original version by: Nikos Drakos, CBLU, University of Leeds - - - + + + - next - + up - previous - contents
        - Next: psb_cdasb Communication - Up: Data management routines - Previous: psb_cdall Allocates -   Next: psb_cdall Allocates + Up: userhtml + Previous: psb_scatter Scatter +   Contents

        -

        -psb_cdins -- Communication descriptor insert routine -

        +

        + +
        +Data management routines +

        -

        -call psb_cdins(nz, ia, ja, desc_a, info)
        -
        +

        + +Subsections -

        -This subroutine examines the edges of the graph associated with the -discretization mesh (and isomorphic to the sparsity pattern of a -linear system coefficient matrix), storing them as necessary into the -communication descriptor. - -

        -

        -
        Type:
        -
        Asynchronous. -
        -
        On Entry
        -
        -
        -
        nz
        -
        the number of points being inserted. -
        -Scope: local. -
        -Type: required. -
        -Intent: in. -
        -Specified as: an integer value. -
        -
        ia
        -
        the indices of the starting vertex of the edges being inserted. -
        -Scope: local. -
        -Type: required. -
        -Intent: in. -
        -Specified as: an integer array of length $nz$. -
        -
        ja
        -
        the indices of the end vertex of the edges being inserted. -
        -Scope: local. -
        -Type: required. -
        -Intent: in. -
        -Specified as: an integer array of length $nz$. -
        -
        - -

        -

        -
        On Return
        -
        -
        -
        desc_a
        -
        the updated communication descriptor. -
        -Scope:local. -
        -Type:required. -
        -Intent: inout. -
        -Specified as: a structured data of type descdatapsb_desc_type. -
        -
        info
        -
        Error code. -
        -Scope: local -
        -Type: required -
        -Intent: out. -
        -An integer value; 0 means no error has been detected. -
        -
        -Notes - -
          -
        1. This routine may only be called if the descriptor is in the - build state; -
        2. -
        3. This routine automatically ignores edges that do not -insist on the current process, i.e. edges for which neither the starting -nor the end vertex belong to the current process. -
        4. -
        - -

        -


        - - -next - -up - -previous - -contents -
        - Next: psb_cdasb Communication - Up: Data management routines - Previous: psb_cdall Allocates -   Contents - + + +

        diff --git a/docs/html/node46.html b/docs/html/node46.html index 59665ae9f..8a6931604 100644 --- a/docs/html/node46.html +++ b/docs/html/node46.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_cdasb -- Communication descriptor assembly routine - +psb_cdall -- Allocates a communication descriptor + @@ -20,64 +20,189 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_cdcpy Copies - Up: Data management routines - Previous: psb_cdins Communication -   Next: psb_cdins Communication + Up: Data management routines + Previous: Data management routines +   Contents

        -

        -psb_cdasb -- Communication descriptor assembly routine +

        +psb_cdall -- Allocates a communication descriptor

        -call psb_cdasb(desc_a, info)
        +call psb_cdall(icontxt, desc_a, info,mg=mg,parts=parts)
        +call psb_cdall(icontxt, desc_a, info,vg=vg,[mg=mg,flag=flag])
        +call psb_cdall(icontxt, desc_a, info,vl=vl,[nl=nl,globalcheck=.true.])
        +call psb_cdall(icontxt, desc_a, info,nl=nl)
        +call psb_cdall(icontxt, desc_a, info,mg=mg,repl=.true.)
         

        +This subroutine initializes the communication descriptor associated +with an index space. One of the optional arguments +parts, vg, vl, nl or repl +must be specified, thereby choosing +the specific initialization strategy.

        +
        On Entry
        +
        +
        Type:
        Synchronous.
        -
        On Entry
        -
        -
        -
        desc_a
        -
        the communication descriptor. +
        icontxt
        +
        the communication context.
        -Scope:local. +Scope:global.
        Type:required.
        -Intent: inout. +Intent: in.
        -Specified as: a structured data of type descdatapsb_desc_type. +Specified as: an integer value. +
        +
        vg
        +
        Data allocation: each index +$i\in \{1\dots mg\}$ is allocated + to process $vg(i)$. +
        +Scope:global. +
        +Type:optional. +
        +Intent: in. +
        +Specified as: an integer array. +
        +
        flag
        +
        Specifies whether entries in $vg$ are zero- or one-based. +
        +Scope:global. +
        +Type:optional. +
        +Intent: in. +
        +Specified as: an integer value $0,1$, default $0$. + +

        +

        +
        mg
        +
        the (global) number of rows of the problem. +
        +Scope:global. +
        +Type:optional. +
        +Intent: in. +
        +Specified as: an integer value. It is required if parts or +repl is specified, it is optional if vg is specified. +
        +
        parts
        +
        the subroutine that defines the partitioning scheme. +
        +Scope:global. +
        +Type:required. +
        +Specified as: a subroutine. +
        +
        vl
        +
        Data allocation: the set of global indices + $vl(1:nl)$ belonging to the calling process. +
        +Scope:local. +
        +Type:optional. +
        +Intent: in. +
        +Specified as: an integer array. +
        +
        nl
        +
        Data allocation: in a generalized block-row distribution the + number of indices belonging to the current process. +
        +Scope:local. +
        +Type:optional. +
        +Intent: in. +
        +Specified as: an integer value. May be specified together with +vl. +
        +
        repl
        +
        Data allocation: build a replicated index space (i.e. all + processes own all indices). +
        +Scope:global. +
        +Type:optional. +
        +Intent: in. +
        +Specified as: the logical value .true. +
        +
        globalcheck
        +
        Data allocation: do global checks on the local + index lists vl +
        +Scope:global. +
        +Type:optional. +
        +Intent: in. +
        +Specified as: a logical value, default: .true.
        @@ -93,7 +218,7 @@ Scope:local.
        Type:required.
        -Intent: inout. +Intent: out.
        Specified as: a structured data of type descdatapsb_desc_type. @@ -109,16 +234,191 @@ Intent: out. An integer value; 0 means no error has been detected. + +

        Notes

          -
        1. On exit from this routine the descriptor is in the assembled +
        2. One of the optional arguments parts, vg, + vl, nl or repl must be specified, thereby choosing the + initialization strategy as follows: +
          +
          parts
          +
          In this case we have a subroutine specifying the mapping + between global indices and process/local index pairs. If this + optional argument is specified, then it is mandatory to + specify the argument mg as well. + The subroutine must conform to the following interface: +
          +  interface 
          +     subroutine psb_parts(glob_index,mg,np,pv,nv)
          +       integer, intent (in)  :: glob_index,np,mg
          +       integer, intent (out) :: nv, pv(*)
          +     end subroutine psb_parts
          +  end interface
          +
          + The input arguments are: +
          +
          glob_index
          +
          The global index to be mapped; + +
          +
          np
          +
          The number of processes in the mapping; + +
          +
          mg
          +
          The total number of global rows in the mapping; + +
          +
          + The output arguments are: +
          +
          nv
          +
          The number of entries in pv; + +
          +
          pv
          +
          A vector containing the indices of the processes to + which the global index should be assigend; each entry must satisfy + +$0\le pv(i) < np$; if $nv>1$ we have an index assigned to multiple + processes, i.e. we have an overlap among the subdomains. + +
          +
          +
          +
          vg
          +
          In this case the association between an index and a process + is specified via an integer vector vg(1:mg); + each index +$i\in \{1\dots mg\}$ is assigned to process $vg(i)$. + The vector vg must be identical on all + calling processes; its entries may have the ranges $(0\dots np-1)$ + or $(1\dots np)$ according to the value of flag. + The size $mg$ may be specified via the optional argument mg; + the default is to use the entire vector vg, thus having + mg=size(vg). +
          +
          vl
          +
          In this case we are specifying the list of indices + vl(1:nl) assigned to the current process; thus, the global + problem size $mg$ is given by + the range of the aggregate of the individual vectors vl specified + in the calling processes. The size may be specified via the optional + argument nl; the default is to use the entire vector vl, thus having + nl=size(vl). + If globalcheck=.true. the subroutine will check how many + times each entry in the global index space $(1\dots mg)$ is + specified in the input lists vl, thus allowing for the + presence of overlap in the input, and checking for ``orphan'' + indices. If globalcheck=.false., the subroutine will not + check for overlap, and may be significantly faster, but the user + is implicitly guaranteeing that there are neither orphan nor + overlap indices. +
          +
          nl
          +
          If this argument is specified alone (i.e. without vl) + the result is a generalized row-block distribution in which each + process $I$ gets assigned a consecutive chunk of $N_I=nl$ global + indices. +
          +
          repl
          +
          This arguments specifies to replicate all indices on + all processes. This is a special purpose data allocation that is + useful in the construction of some multilevel preconditioners. +
          +
          +
        3. +
        4. On exit from this routine the descriptor is in the build state.
        5. +
        6. Calling the routine with vg or parts implies that + every process will scan the entire index space to figure out the + local indices. +
        7. +
        8. Overlapped indices are possible with both parts and + vl invocations. +
        9. +
        10. When the subroutine is invoked with vl in + conjunction with globalcheck=.true., it will perform a scan + of the index space to search for overlap or orphan indices. +
        11. +
        12. When the subroutine is invoked with vl in + conjunction with globalcheck=.false., no index space scan + will take place. Thus it is the responsibility of the user to make + sure that the indices specified in vl have neither orphans nor + overlaps; if this assumption fails, results will be + unpredictable. +
        13. +
        14. Orphan and overlap indices are + impossible by construction when the subroutine is invoked with + nl (alone), or vg. +

        -


        +
        + + +next + +up + +previous + +contents +
        + Next: psb_cdins Communication + Up: Data management routines + Previous: Data management routines +   Contents + diff --git a/docs/html/node47.html b/docs/html/node47.html index cb6786949..da6cde42d 100644 --- a/docs/html/node47.html +++ b/docs/html/node47.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_cdcpy -- Copies a communication descriptor - +psb_cdins -- Communication descriptor insert routine + @@ -20,46 +20,52 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_cdfree Frees - Up: Data management routines - Previous: psb_cdasb Communication -   Next: psb_cdasb Communication + Up: Data management routines + Previous: psb_cdall Allocates +   Contents

        -

        -psb_cdcpy -- Copies a communication descriptor +

        +psb_cdins -- Communication descriptor insert routine

        -call psb_cdcpy(desc_in, desc_out, info)
        +call psb_cdins(nz, ia, ja, desc_a, info)
         
        +

        +This subroutine examines the edges of the graph associated with the +discretization mesh (and isomorphic to the sparsity pattern of a +linear system coefficient matrix), storing them as necessary into the +communication descriptor. +

        Type:
        @@ -68,18 +74,44 @@ call psb_cdcpy(desc_in, desc_out, info)
        On Entry
        -
        desc_in
        -
        the communication descriptor. +
        nz
        +
        the number of points being inserted.
        -Scope:local. +Scope: local.
        -Type:required. +Type: required.
        Intent: in.
        -Specified as: a structured data of type descdatapsb_desc_type. - -

        +Specified as: an integer value. +

        +
        ia
        +
        the indices of the starting vertex of the edges being inserted. +
        +Scope: local. +
        +Type: required. +
        +Intent: in. +
        +Specified as: an integer array of length $nz$. +
        +
        ja
        +
        the indices of the end vertex of the edges being inserted. +
        +Scope: local. +
        +Type: required. +
        +Intent: in. +
        +Specified as: an integer array of length $nz$.
        @@ -88,14 +120,14 @@ Specified as: a structured data of type descdatapsb_desc_type.
        On Return
        -
        desc_out
        -
        the communication descriptor copy. +
        desc_a
        +
        the updated communication descriptor.
        Scope:local.
        Type:required.
        -Intent: out. +Intent: inout.
        Specified as: a structured data of type descdatapsb_desc_type.
        @@ -111,9 +143,43 @@ Intent: out. An integer value; 0 means no error has been detected. +Notes + +
          +
        1. This routine may only be called if the descriptor is in the + build state; +
        2. +
        3. This routine automatically ignores edges that do not +insist on the current process, i.e. edges for which neither the starting +nor the end vertex belong to the current process. +
        4. +

        -


        +
        + + +next + +up + +previous + +contents +
        + Next: psb_cdasb Communication + Up: Data management routines + Previous: psb_cdall Allocates +   Contents + diff --git a/docs/html/node48.html b/docs/html/node48.html index c04df3657..c37ecea8e 100644 --- a/docs/html/node48.html +++ b/docs/html/node48.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_cdfree -- Frees a communication descriptor - +psb_cdasb -- Communication descriptor assembly routine + @@ -20,44 +20,44 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_cdbldext Build - Up: Data management routines - Previous: psb_cdcpy Copies -   Next: psb_cdcpy Copies + Up: Data management routines + Previous: psb_cdins Communication +   Contents

        -

        -psb_cdfree -- Frees a communication descriptor +

        +psb_cdasb -- Communication descriptor assembly routine

        -call psb_cdfree(desc_a, info)
        +call psb_cdasb(desc_a, info)
         

        @@ -69,7 +69,7 @@ call psb_cdfree(desc_a, info)

        desc_a
        -
        the communication descriptor to be freed. +
        the communication descriptor.
        Scope:local.
        @@ -86,6 +86,17 @@ Specified as: a structured data of type descdatapsb_desc_type.
        On Return
        +
        desc_a
        +
        the communication descriptor. +
        +Scope:local. +
        +Type:required. +
        +Intent: inout. +
        +Specified as: a structured data of type descdatapsb_desc_type. +
        info
        Error code.
        @@ -98,6 +109,13 @@ Intent: out. An integer value; 0 means no error has been detected.
        +Notes + +
          +
        1. On exit from this routine the descriptor is in the assembled + state. +
        2. +



        diff --git a/docs/html/node49.html b/docs/html/node49.html index 889b1110a..d228b2726 100644 --- a/docs/html/node49.html +++ b/docs/html/node49.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_cdbldext -- Build an extended communication descriptor - +psb_cdcpy -- Copies a communication descriptor + @@ -20,69 +20,55 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_spall Allocates - Up: Data management routines - Previous: psb_cdfree Frees -   Next: psb_cdfree Frees + Up: Data management routines + Previous: psb_cdasb Communication +   Contents

        -

        -psb_cdbldext -- Build an extended communication - descriptor +

        +psb_cdcpy -- Copies a communication descriptor

        -call psb_cdbldext(a,desc_a,nl,desc_out, info, extype)
        +call psb_cdcpy(desc_in, desc_out, info)
         

        -This subroutine builds an extended communication descriptor, based on -the input descriptor desc_a and on the stencil specified -through the input sparse matrix a.

        Type:
        -
        Synchronous. +
        Asynchronous.
        On Entry
        -
        a
        -
        A sparse matrix -Scope:local. -
        -Type:required. -
        -Intent: in. -
        -Specified as: a structured data type. -
        -
        desc_a
        +
        desc_in
        the communication descriptor.
        Scope:local. @@ -91,33 +77,7 @@ Type:required.
        Intent: in.
        -Specified as: a structured data of type spdatapsb_spmat_type. -
        -
        nl
        -
        the number of additional layers desired. -
        -Scope:global. -
        -Type:required. -
        -Intent: in. -
        -Specified as: an integer value $nl\ge 0$. -
        -
        extype
        -
        the kind of estension required. -
        -Scope:global. -
        -Type:optional . -
        -Intent: in. -
        -Specified as: an integer value -psb_ovt_xhal_, psb_ovt_asov_, default: psb_ovt_xhal_ +Specified as: a structured data of type descdatapsb_desc_type.

        @@ -129,13 +89,13 @@ Specified as: an integer value
        desc_out
        -
        the extended communication descriptor. +
        the communication descriptor copy.
        Scope:local.
        Type:required.
        -Intent: inout. +Intent: out.
        Specified as: a structured data of type descdatapsb_desc_type.
        @@ -153,48 +113,7 @@ An integer value; 0 means no error has been detected.

        -Notes - -

          -
        1. Specifying psb_ovt_xhal_ for the extype argument - the user will obtain a descriptor for a domain partition in which - the additional layers are fetched as part of an (extended) halo; - however the index-to-process mapping is identical to that of the - base descriptor; -
        2. -
        3. Specifying psb_ovt_asov_ for the extype argument - the user will obtain a descriptor with an overlapped decomposition: - the additional layer is aggregated to the local subdomain (and thus - is an overlap), and a new halo extending beyond the last additional - layer is formed. -
        4. -
        - -

        -


        - - -next - -up - -previous - -contents -
        - Next: psb_spall Allocates - Up: Data management routines - Previous: psb_cdfree Frees -   Contents - +

        diff --git a/docs/html/node5.html b/docs/html/node5.html index bfd23993c..3712399ff 100644 --- a/docs/html/node5.html +++ b/docs/html/node5.html @@ -26,26 +26,26 @@ original version by: Nikos Drakos, CBLU, University of Leeds - next - up - previous - contents
        - Next: Next: Application structure - Up: Up: General overview - Previous: Previous: Basic Nomenclature -   Contents

        @@ -128,7 +128,7 @@ internally defined in the PSBLAS software package: For example the psb_geins, psb_spins and - psb_cdins perform the same action (see 6) on + psb_cdins perform the same action (see 6) on dense matrices, sparse matrices and communication descriptors respectively. Interface overloading allows the usage of the same subroutine @@ -169,26 +169,26 @@ whose current value is 3.0.0


        - next - up - previous - contents
        - Next: Next: Application structure - Up: Up: General overview - Previous: Previous: Basic Nomenclature -   Contents diff --git a/docs/html/node50.html b/docs/html/node50.html index e4c53864a..fde48e793 100644 --- a/docs/html/node50.html +++ b/docs/html/node50.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_spall -- Allocates a sparse matrix - +psb_cdfree -- Frees a communication descriptor + @@ -20,44 +20,44 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_spins Insert - Up: Data management routines - Previous: psb_cdbldext Build -   Next: psb_cdbldext Build + Up: Data management routines + Previous: psb_cdcpy Copies +   Contents

        -

        -psb_spall -- Allocates a sparse matrix +

        +psb_cdfree -- Frees a communication descriptor

        -call psb_spall(a, desc_a, info, nnz)
        +call psb_cdfree(desc_a, info)
         

        @@ -69,28 +69,16 @@ call psb_spall(a, desc_a, info, nnz)

        desc_a
        -
        the communication descriptor. +
        the communication descriptor to be freed.
        Scope:local.
        Type:required.
        -Intent: in. +Intent: inout.
        Specified as: a structured data of type descdatapsb_desc_type.
        -
        nnz
        -
        An estimate of the number of nonzeroes in the local - part of the assembled matrix. -
        -Scope: global. -
        -Type: optional. -
        -Intent: in. -
        -Specified as: an integer value. -

        @@ -98,17 +86,6 @@ Specified as: an integer value.

        On Return
        -
        a
        -
        the matrix to be allocated. -
        -Scope:local -
        -Type:required -
        -Intent: out. -
        -Specified as: a structured data of type spdatapsb_spmat_type. -
        info
        Error code.
        @@ -121,49 +98,9 @@ Intent: out. An integer value; 0 means no error has been detected.
        -Notes - -
          -
        1. On exit from this routine the sparse matrix is in the build - state. -
        2. -
        3. The descriptor may be in either the build or assembled state. -
        4. -
        5. Providing a good estimate for the number of nonzeroes $nnz$ in - the assembled matrix may substantially improve performance in the - matrix build phase, as it will reduce or eliminate the need for - (potentially multiple) data reallocations. -
        6. -

        -


        - - -next - -up - -previous - -contents -
        - Next: psb_spins Insert - Up: Data management routines - Previous: psb_cdbldext Build -   Contents - +

        diff --git a/docs/html/node51.html b/docs/html/node51.html index 096b5a719..061c50d76 100644 --- a/docs/html/node51.html +++ b/docs/html/node51.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_spins -- Insert a cloud of elements into a sparse matrix - +psb_cdbldext -- Build an extended communication descriptor + @@ -20,123 +20,107 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_spasb Sparse - Up: Data management routines - Previous: psb_spall Allocates -   Next: psb_spall Allocates + Up: Data management routines + Previous: psb_cdfree Frees +   Contents

        -

        -psb_spins -- Insert a cloud of elements into a sparse - matrix +

        +psb_cdbldext -- Build an extended communication + descriptor

        -call psb_spins(nz, ia, ja, val, a, desc_a, info)
        +call psb_cdbldext(a,desc_a,nl,desc_out, info, extype)
         

        +This subroutine builds an extended communication descriptor, based on +the input descriptor desc_a and on the stencil specified +through the input sparse matrix a.

        Type:
        -
        Asynchronous. +
        Synchronous.
        On Entry
        -
        nz
        -
        the number of elements to be inserted. -
        +
        a
        +
        A sparse matrix Scope:local.
        Type:required.
        Intent: in.
        -Specified as: an integer scalar. -
        -
        ia
        -
        the row indices of the elements to be inserted. -
        -Scope:local. -
        -Type:required. -
        -Intent: in. -
        -Specified as: an integer array of size $nz$. -
        -
        ja
        -
        the column indices of the elements to be inserted. -
        -Scope:local. -
        -Type:required. -
        -Intent: in. -
        -Specified as: an integer array of size $nz$. -
        -
        val
        -
        the elements to be inserted. -
        -Scope:local. -
        -Type:required. -
        -Intent: in. -
        -Specified as: an array of size $nz$. Must be of the same type and kind -of the aspk component of the sparse matrix $a$. +Specified as: a structured data type.
        desc_a
        -
        The communication descriptor. +
        the communication descriptor.
        -Scope: local. +Scope:local.
        -Type: required. +Type:required.
        -Intent: inout. +Intent: in.
        -Specified as: a variable of type descdatapsb_desc_type. -
        +Specified as: a structured data of type spdatapsb_spmat_type. + +
        nl
        +
        the number of additional layers desired. +
        +Scope:global. +
        +Type:required. +
        +Intent: in. +
        +Specified as: an integer value $nl\ge 0$. +
        +
        extype
        +
        the kind of estension required. +
        +Scope:global. +
        +Type:optional . +
        +Intent: in. +
        +Specified as: an integer value +psb_ovt_xhal_, psb_ovt_asov_, default: psb_ovt_xhal_ + +

        +

        @@ -144,28 +128,17 @@ Specified as: a variable of type descdatapsb_desc_type.

        On Return
        -
        a
        -
        the matrix into which elements will be inserted. +
        desc_out
        +
        the extended communication descriptor.
        -Scope:local +Scope:local.
        -Type:required +Type:required.
        Intent: inout.
        -Specified as: a structured data of type spdatapsb_spmat_type. +Specified as: a structured data of type descdatapsb_desc_type.
        -
        desc_a
        -
        The communication descriptor. -
        -Scope: local. -
        -Type: required. -
        -Intent: inout. -
        -Specified as: a variable of type descdatapsb_desc_type. -
        info
        Error code.
        @@ -183,54 +156,43 @@ An integer value; 0 means no error has been detected. Notes
          -
        1. On entry to this routine the descriptor may be in either the - build or assembled state. +
        2. Specifying psb_ovt_xhal_ for the extype argument + the user will obtain a descriptor for a domain partition in which + the additional layers are fetched as part of an (extended) halo; + however the index-to-process mapping is identical to that of the + base descriptor;
        3. -
        4. On entry to this routine the sparse matrix may be in either the - build or update state. -
        5. -
        6. If the descriptor is in the build state, then the sparse matrix - must also be in the build state; the action of the routine is to - (implicitly) call psb_cdins to add entries to the sparsity - pattern; each sparse matrix entry implicitly defines a graph edge, - that is passed to the descriptor routine for the appropriate - processing. -
        7. -
        8. Any coefficients from matrix rows not assigned to the calling - process are silently ignored; -
        9. -
        10. If the descriptor is in the assembled state, then any entries in - the sparse matrix that would generate additional communication - requirements will be ignored; -
        11. -
        12. If the matrix is in the update state, any entries in positions - that were not present in the original matrix will be ignored. +
        13. Specifying psb_ovt_asov_ for the extype argument + the user will obtain a descriptor with an overlapped decomposition: + the additional layer is aggregated to the local subdomain (and thus + is an overlap), and a new halo extending beyond the last additional + layer is formed.


        - next - + up - previous - contents
        - Next: psb_spasb Sparse - Up: Data management routines - Previous: psb_spall Allocates -   Next: psb_spall Allocates + Up: Data management routines + Previous: psb_cdfree Frees +   Contents diff --git a/docs/html/node52.html b/docs/html/node52.html index 80bcc9baa..f3150cbac 100644 --- a/docs/html/node52.html +++ b/docs/html/node52.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_spasb -- Sparse matrix assembly routine - +psb_spall -- Allocates a sparse matrix + @@ -20,44 +20,44 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_spfree Frees - Up: Data management routines - Previous: psb_spins Insert -   Next: psb_spins Insert + Up: Data management routines + Previous: psb_cdbldext Build +   Contents

        -

        -psb_spasb -- Sparse matrix assembly routine +

        +psb_spall -- Allocates a sparse matrix

        -call psb_spasb(a, desc_a, info, afmt, upd, dupl)
        +call psb_spall(a, desc_a, info, nnz)
         

        @@ -79,8 +79,9 @@ Intent: in.
        Specified as: a structured data of type descdatapsb_desc_type.

        -
        afmt
        -
        the storage format for the sparse matrix. +
        nnz
        +
        An estimate of the number of nonzeroes in the local + part of the assembled matrix.
        Scope: global.
        @@ -88,30 +89,7 @@ Type: optional.
        Intent: in.
        -Specified as: an array of characters. Defalt: 'CSR'. -
        -
        upd
        -
        Provide for updates to the matrix coefficients. -
        -Scope: global. -
        -Type: optional. -
        -Intent: in. -
        -Specified as: integer, possible values: psb_upd_srch_, psb_upd_perm_ -
        -
        dupl
        -
        How to handle duplicate coefficients. -
        -Scope: global. -
        -Type: optional. -
        -Intent: in. -
        -Specified as: integer, possible values: psb_dupl_ovwrt_, -psb_dupl_add_, psb_dupl_err_. +Specified as: an integer value.
        @@ -121,13 +99,13 @@ Specified as: integer, possible values: psb_dupl_ovwrt_,
        a
        -
        the matrix to be assembled. +
        the matrix to be allocated.
        Scope:local
        Type:required
        -Intent: inout. +Intent: out.
        Specified as: a structured data of type spdatapsb_spmat_type.
        @@ -143,53 +121,47 @@ Intent: out. An integer value; 0 means no error has been detected. - -

        Notes

          -
        1. On entry to this routine the descriptor must be in the - assembled state, i.e. psb_cdasb must already have been called. +
        2. On exit from this routine the sparse matrix is in the build + state.
        3. -
        4. The sparse matrix may be in either the build or update state; +
        5. The descriptor may be in either the build or assembled state.
        6. -
        7. Duplicate entries are detected and handled in both build and - update state, with the exception of the error action that is only - taken in the build state, i.e. on the first assembly; -
        8. -
        9. If the update choice is psb_upd_perm_, then subsequent - calls to psb_spins to update the matrix must be arranged in - such a way as to produce exactly the same sequence of coefficient - values as encountered at the first assembly; -
        10. -
        11. On exit from this routine the matrix is in the assembled state, - and thus is suitable for the computational routines. +
        12. Providing a good estimate for the number of nonzeroes $nnz$ in + the assembled matrix may substantially improve performance in the + matrix build phase, as it will reduce or eliminate the need for + (potentially multiple) data reallocations.


        - next - + up - previous - contents
        - Next: psb_spfree Frees - Up: Data management routines - Previous: psb_spins Insert -   Next: psb_spins Insert + Up: Data management routines + Previous: psb_cdbldext Build +   Contents diff --git a/docs/html/node53.html b/docs/html/node53.html index abaf4cf6c..0f3142393 100644 --- a/docs/html/node53.html +++ b/docs/html/node53.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_spfree -- Frees a sparse matrix - +psb_spins -- Insert a cloud of elements into a sparse matrix + @@ -20,56 +20,132 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_sprn Reinit - Up: Data management routines - Previous: psb_spasb Sparse -   Next: psb_spasb Sparse + Up: Data management routines + Previous: psb_spall Allocates +   Contents

        -

        -psb_spfree -- Frees a sparse matrix +

        +psb_spins -- Insert a cloud of elements into a sparse + matrix

        -call psb_spfree(a, desc_a, info)
        +call psb_spins(nz, ia, ja, val, a, desc_a, info)
         

        Type:
        -
        Synchronous. +
        Asynchronous.
        On Entry
        +
        nz
        +
        the number of elements to be inserted. +
        +Scope:local. +
        +Type:required. +
        +Intent: in. +
        +Specified as: an integer scalar. +
        +
        ia
        +
        the row indices of the elements to be inserted. +
        +Scope:local. +
        +Type:required. +
        +Intent: in. +
        +Specified as: an integer array of size $nz$. +
        +
        ja
        +
        the column indices of the elements to be inserted. +
        +Scope:local. +
        +Type:required. +
        +Intent: in. +
        +Specified as: an integer array of size $nz$. +
        +
        val
        +
        the elements to be inserted. +
        +Scope:local. +
        +Type:required. +
        +Intent: in. +
        +Specified as: an array of size $nz$. Must be of the same type and kind +of the aspk component of the sparse matrix $a$. +
        +
        desc_a
        +
        The communication descriptor. +
        +Scope: local. +
        +Type: required. +
        +Intent: inout. +
        +Specified as: a variable of type descdatapsb_desc_type. +
        +
        + +

        +

        +
        On Return
        +
        +
        a
        -
        the matrix to be freed. +
        the matrix into which elements will be inserted.
        Scope:local
        @@ -80,23 +156,16 @@ Intent: inout. Specified as: a structured data of type spdatapsb_spmat_type.
        desc_a
        -
        the communication descriptor. +
        The communication descriptor.
        -Scope:local. +Scope: local.
        -Type:required. +Type: required.
        -Intent: in. +Intent: inout.
        -Specified as: a structured data of type descdatapsb_desc_type. -
        -
        - -

        -

        -
        On Return
        -
        -
        +Specified as: a variable of type descdatapsb_desc_type. +
        info
        Error code.
        @@ -111,7 +180,59 @@ An integer value; 0 means no error has been detected.

        -


        +Notes + +
          +
        1. On entry to this routine the descriptor may be in either the + build or assembled state. +
        2. +
        3. On entry to this routine the sparse matrix may be in either the + build or update state. +
        4. +
        5. If the descriptor is in the build state, then the sparse matrix + must also be in the build state; the action of the routine is to + (implicitly) call psb_cdins to add entries to the sparsity + pattern; each sparse matrix entry implicitly defines a graph edge, + that is passed to the descriptor routine for the appropriate + processing. +
        6. +
        7. Any coefficients from matrix rows not assigned to the calling + process are silently ignored; +
        8. +
        9. If the descriptor is in the assembled state, then any entries in + the sparse matrix that would generate additional communication + requirements will be ignored; +
        10. +
        11. If the matrix is in the update state, any entries in positions + that were not present in the original matrix will be ignored. +
        12. +
        + +

        +


        + + +next + +up + +previous + +contents +
        + Next: psb_spasb Sparse + Up: Data management routines + Previous: psb_spall Allocates +   Contents + diff --git a/docs/html/node54.html b/docs/html/node54.html index f8e0a9366..a5029e33e 100644 --- a/docs/html/node54.html +++ b/docs/html/node54.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_sprn -- Reinit sparse matrix structure for psblas routines. - +psb_spasb -- Sparse matrix assembly routine + @@ -20,45 +20,44 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_geall Allocates - Up: Data management routines - Previous: psb_spfree Frees -   Next: psb_spfree Frees + Up: Data management routines + Previous: psb_spins Insert +   Contents

        -

        -psb_sprn -- Reinit sparse matrix structure for psblas - routines. +

        +psb_spasb -- Sparse matrix assembly routine

        -call psb_sprn(a, decsc_a, info, clear)
        +call psb_spasb(a, desc_a, info, afmt, upd, dupl)
         

        @@ -69,17 +68,6 @@ call psb_sprn(a, decsc_a, info, clear)

        On Entry
        -
        a
        -
        the matrix to be reinitialized. -
        -Scope:local -
        -Type:required -
        -Intent: inout. -
        -Specified as: a structured data of type spdatapsb_spmat_type. -
        desc_a
        the communication descriptor.
        @@ -91,16 +79,39 @@ Intent: in.
        Specified as: a structured data of type descdatapsb_desc_type.
        -
        clear
        -
        Choose whether to zero out matrix coefficients +
        afmt
        +
        the storage format for the sparse matrix.
        -Scope:local. +Scope: global.
        -Type:optional. +Type: optional.
        Intent: in.
        -Default: true. +Specified as: an array of characters. Defalt: 'CSR'. +
        +
        upd
        +
        Provide for updates to the matrix coefficients. +
        +Scope: global. +
        +Type: optional. +
        +Intent: in. +
        +Specified as: integer, possible values: psb_upd_srch_, psb_upd_perm_ +
        +
        dupl
        +
        How to handle duplicate coefficients. +
        +Scope: global. +
        +Type: optional. +
        +Intent: in. +
        +Specified as: integer, possible values: psb_dupl_ovwrt_, +psb_dupl_add_, psb_dupl_err_.
        @@ -109,6 +120,17 @@ Default: true.
        On Return
        +
        a
        +
        the matrix to be assembled. +
        +Scope:local +
        +Type:required +
        +Intent: inout. +
        +Specified as: a structured data of type spdatapsb_spmat_type. +
        info
        Error code.
        @@ -121,16 +143,55 @@ Intent: out. An integer value; 0 means no error has been detected.
        + +

        Notes

          -
        1. On exit from this routine the sparse matrix is in the update - state. +
        2. On entry to this routine the descriptor must be in the + assembled state, i.e. psb_cdasb must already have been called. +
        3. +
        4. The sparse matrix may be in either the build or update state; +
        5. +
        6. Duplicate entries are detected and handled in both build and + update state, with the exception of the error action that is only + taken in the build state, i.e. on the first assembly; +
        7. +
        8. If the update choice is psb_upd_perm_, then subsequent + calls to psb_spins to update the matrix must be arranged in + such a way as to produce exactly the same sequence of coefficient + values as encountered at the first assembly; +
        9. +
        10. On exit from this routine the matrix is in the assembled state, + and thus is suitable for the computational routines.

        -


        +
        + + +next + +up + +previous + +contents +
        + Next: psb_spfree Frees + Up: Data management routines + Previous: psb_spins Insert +   Contents + diff --git a/docs/html/node55.html b/docs/html/node55.html index f757a0774..b84fe625a 100644 --- a/docs/html/node55.html +++ b/docs/html/node55.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_geall -- Allocates a dense matrix - +psb_spfree -- Frees a sparse matrix + @@ -20,44 +20,44 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_geins Dense - Up: Data management routines - Previous: psb_sprn Reinit -   Next: psb_sprn Reinit + Up: Data management routines + Previous: psb_spasb Sparse +   Contents

        -

        -psb_geall -- Allocates a dense matrix +

        +psb_spfree -- Frees a sparse matrix

        -call psb_geall(x, desc_a, info, n, lb)
        +call psb_spfree(a, desc_a, info)
         

        @@ -68,52 +68,27 @@ call psb_geall(x, desc_a, info, n, lb)

        On Entry
        -
        desc_a
        -
        The communication descriptor. +
        a
        +
        the matrix to be freed.
        -Scope: local +Scope:local
        -Type: required +Type:required
        -Intent: in. +Intent: inout.
        -Specified as: a variable of type descdatapsb_desc_type. -
        -
        n
        -
        The number of columns of the dense matrix to be allocated. -
        -Scope: local -
        -Type: optional -
        -Intent: in. -
        -Specified as: Integer scalar, default $1$. It is not a valid argument if $x$ is a -rank-1 array. +Specified as: a structured data of type spdatapsb_spmat_type.
        -
        lb
        -
        The lower bound for the column index range of the dense matrix to be allocated. +
        desc_a
        +
        the communication descriptor.
        -Scope: local +Scope:local.
        -Type: optional +Type:required.
        Intent: in.
        -Specified as: Integer scalar, default $1$. It is not a valid argument if $x$ is a -rank-1 array. +Specified as: a structured data of type descdatapsb_desc_type.
        @@ -122,18 +97,6 @@ rank-1 array.
        On Return
        -
        x
        -
        The dense matrix to be allocated. -
        -Scope: local -
        -Type: required -
        -Intent: out. -
        -Specified as: a rank one or two array with the ALLOCATABLE -attribute, of type real, complex or integer. -
        info
        Error code.
        diff --git a/docs/html/node56.html b/docs/html/node56.html index 80bb4c043..e4064a1e8 100644 --- a/docs/html/node56.html +++ b/docs/html/node56.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_geins -- Dense matrix insertion routine - +psb_sprn -- Reinit sparse matrix structure for psblas routines. + @@ -20,100 +20,65 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_geasb Assembly - Up: Data management routines - Previous: psb_geall Allocates -   Next: psb_geall Allocates + Up: Data management routines + Previous: psb_spfree Frees +   Contents

        -

        -psb_geins -- Dense matrix insertion routine +

        +psb_sprn -- Reinit sparse matrix structure for psblas + routines.

        -call psb_geins(m, irw, val, x, desc_a, info,dupl)
        +call psb_sprn(a, decsc_a, info, clear)
         

        Type:
        -
        Asynchronous. +
        Synchronous.
        On Entry
        -
        m
        -
        Number of rows in $val$ to be inserted. +
        a
        +
        the matrix to be reinitialized.
        -Scope:local. +Scope:local
        -Type:required. +Type:required
        -Intent: in. +Intent: inout.
        -Specified as: an integer value. -
        -
        irw
        -
        Indices of the rows to be inserted. Specifically, row $i$ - of $val$ will be inserted into the local row corresponding to the - global row index $irw(i)$. -Scope:local. -
        -Type:required. -
        -Intent: in. -
        -Specified as: an integer array. -
        -
        val
        -
        the dense submatrix to be inserted. -
        -Scope:local. -
        -Type:required. -
        -Intent: in. -
        -Specified as: a rank 1 or 2 array. -Specified as: an integer value. +Specified as: a structured data of type spdatapsb_spmat_type.
        desc_a
        the communication descriptor. @@ -126,17 +91,16 @@ Intent: in.
        Specified as: a structured data of type descdatapsb_desc_type.
        -
        dupl
        -
        How to handle duplicate coefficients. +
        clear
        +
        Choose whether to zero out matrix coefficients
        -Scope: global. +Scope:local.
        -Type: optional. +Type:optional.
        Intent: in.
        -Specified as: integer, possible values: psb_dupl_ovwrt_, -psb_dupl_add_. +Default: true.
        @@ -145,18 +109,6 @@ Specified as: integer, possible values: psb_dupl_ovwrt_,
        On Return
        -
        x
        -
        the output dense matrix. -
        -Scope: local -
        -Type: required -
        -Intent: inout. -
        -Specified as: a rank one or two array with the ALLOCATABLE -attribute, of type real, complex or integer. -
        info
        Error code.
        @@ -169,43 +121,16 @@ Intent: out. An integer value; 0 means no error has been detected.
        - -

        Notes

          -
        1. Dense vectors/matrices do not have an associated state; -
        2. -
        3. Duplicate entries are either overwritten or added, there is no - provision for raising an error condition. +
        4. On exit from this routine the sparse matrix is in the update + state.

        -


        - - -next - -up - -previous - -contents -
        - Next: psb_geasb Assembly - Up: Data management routines - Previous: psb_geall Allocates -   Contents - +

        diff --git a/docs/html/node57.html b/docs/html/node57.html index 6a736b444..dc8458b05 100644 --- a/docs/html/node57.html +++ b/docs/html/node57.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_geasb -- Assembly a dense matrix - +psb_geall -- Allocates a dense matrix + @@ -20,44 +20,44 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_gefree Frees - Up: Data management routines - Previous: psb_geins Dense -   Next: psb_geins Dense + Up: Data management routines + Previous: psb_sprn Reinit +   Contents

        -

        -psb_geasb -- Assembly a dense matrix +

        +psb_geall -- Allocates a dense matrix

        -call psb_geasb(x, desc_a, info)
        +call psb_geall(x, desc_a, info, n, lb)
         

        @@ -79,6 +79,42 @@ Intent: in.
        Specified as: a variable of type descdatapsb_desc_type.
        +

        n
        +
        The number of columns of the dense matrix to be allocated. +
        +Scope: local +
        +Type: optional +
        +Intent: in. +
        +Specified as: Integer scalar, default $1$. It is not a valid argument if $x$ is a +rank-1 array. +
        +
        lb
        +
        The lower bound for the column index range of the dense matrix to be allocated. +
        +Scope: local +
        +Type: optional +
        +Intent: in. +
        +Specified as: Integer scalar, default $1$. It is not a valid argument if $x$ is a +rank-1 array. +

        @@ -87,13 +123,13 @@ Specified as: a variable of type descdatapsb_desc_type.

        x
        -
        The dense matrix to be assembled. +
        The dense matrix to be allocated.
        Scope: local
        Type: required
        -Intent: inout. +Intent: out.
        Specified as: a rank one or two array with the ALLOCATABLE attribute, of type real, complex or integer. @@ -110,6 +146,8 @@ Intent: out. An integer value; 0 means no error has been detected.
        + +



        diff --git a/docs/html/node58.html b/docs/html/node58.html index 09ab4c669..63efe8200 100644 --- a/docs/html/node58.html +++ b/docs/html/node58.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_gefree -- Frees a dense matrix - +psb_geins -- Dense matrix insertion routine + @@ -20,57 +20,133 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_gelp Applies - Up: Data management routines - Previous: psb_geasb Assembly -   Next: psb_geasb Assembly + Up: Data management routines + Previous: psb_geall Allocates +   Contents

        -

        -psb_gefree -- Frees a dense matrix +

        +psb_geins -- Dense matrix insertion routine

        -call psb_gefree(x, desc_a, info)
        +call psb_geins(m, irw, val, x, desc_a, info,dupl)
         

        Type:
        -
        Synchronous. +
        Asynchronous.
        On Entry
        +
        m
        +
        Number of rows in $val$ to be inserted. +
        +Scope:local. +
        +Type:required. +
        +Intent: in. +
        +Specified as: an integer value. +
        +
        irw
        +
        Indices of the rows to be inserted. Specifically, row $i$ + of $val$ will be inserted into the local row corresponding to the + global row index $irw(i)$. +Scope:local. +
        +Type:required. +
        +Intent: in. +
        +Specified as: an integer array. +
        +
        val
        +
        the dense submatrix to be inserted. +
        +Scope:local. +
        +Type:required. +
        +Intent: in. +
        +Specified as: a rank 1 or 2 array. +Specified as: an integer value. +
        +
        desc_a
        +
        the communication descriptor. +
        +Scope:local. +
        +Type:required. +
        +Intent: in. +
        +Specified as: a structured data of type descdatapsb_desc_type. +
        +
        dupl
        +
        How to handle duplicate coefficients. +
        +Scope: global. +
        +Type: optional. +
        +Intent: in. +
        +Specified as: integer, possible values: psb_dupl_ovwrt_, +psb_dupl_add_. +
        +
        + +

        +

        +
        On Return
        +
        +
        x
        -
        The dense matrix to - be freed. +
        the output dense matrix.
        Scope: local
        @@ -80,27 +156,7 @@ Intent: inout.
        Specified as: a rank one or two array with the ALLOCATABLE attribute, of type real, complex or integer. -
        -

        -

        -
        desc_a
        -
        The communication descriptor. -
        -Scope: local -
        -Type: required -
        -Intent: in. -
        -Specified as: a variable of type descdatapsb_desc_type.
        -
        - -

        -

        -
        On Return
        -
        -
        info
        Error code.
        @@ -115,7 +171,41 @@ An integer value; 0 means no error has been detected.

        -


        +Notes + +
          +
        1. Dense vectors/matrices do not have an associated state; +
        2. +
        3. Duplicate entries are either overwritten or added, there is no + provision for raising an error condition. +
        4. +
        + +

        +


        + + +next + +up + +previous + +contents +
        + Next: psb_geasb Assembly + Up: Data management routines + Previous: psb_geall Allocates +   Contents + diff --git a/docs/html/node59.html b/docs/html/node59.html index d5dbd99cc..ee570e06c 100644 --- a/docs/html/node59.html +++ b/docs/html/node59.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_gelp -- Applies a left permutation to a dense matrix - +psb_geasb -- Assembly a dense matrix + @@ -20,63 +20,56 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_glob_to_loc Global - Up: Data management routines - Previous: psb_gefree Frees -   Next: psb_gefree Frees + Up: Data management routines + Previous: psb_geins Dense +   Contents

        -

        -psb_gelp -- Applies a left permutation to a dense - matrix +

        +psb_geasb -- Assembly a dense matrix

        -call psb_gelp(trans, iperm, x, info)
        +call psb_geasb(x, desc_a, info)
         

        Type:
        -
        Asynchronous. +
        Synchronous.
        On Entry
        -
        trans
        -
        A character that specifies whether to permute $A$ or $A^T$. +
        desc_a
        +
        The communication descriptor.
        Scope: local
        @@ -84,35 +77,7 @@ Type: required
        Intent: in.
        -Specified as: a single character with value 'N' for $A$ or 'T' for $A^T$. -
        -
        iperm
        -
        An integer array containing permutation information. -
        -Scope: local -
        -Type: required -
        -Intent: in. -
        -Specified as: an integer one-dimensional array. -
        -
        x
        -
        The dense matrix to be permuted. -
        -Scope: local -
        -Type: required -
        -Intent: inout. -
        -Specified as: a one or two dimensional array. +Specified as: a variable of type descdatapsb_desc_type.
        @@ -121,6 +86,18 @@ Specified as: a one or two dimensional array.
        On Return
        +
        x
        +
        The dense matrix to be assembled. +
        +Scope: local +
        +Type: required +
        +Intent: inout. +
        +Specified as: a rank one or two array with the ALLOCATABLE +attribute, of type real, complex or integer. +
        info
        Error code.
        @@ -133,8 +110,6 @@ Intent: out. An integer value; 0 means no error has been detected.
        - -



        diff --git a/docs/html/node6.html b/docs/html/node6.html index 8e27d8361..dc134fd94 100644 --- a/docs/html/node6.html +++ b/docs/html/node6.html @@ -26,26 +26,26 @@ original version by: Nikos Drakos, CBLU, University of Leeds - next - up - previous - contents
        - Next: Next: Programming model - Up: Up: General overview - Previous: Previous: Library contents -   Contents

        @@ -62,7 +62,7 @@ space to which there corresponds an index space and a matrix sparsity pattern. As an example, consider a cell-centered finite-volume discretization of the Navier-Stokes equations on a simulation domain; the index space $1\dots n$ is isomorphic to the set of cell centers, whereas the pattern of the associated linear system matrix is @@ -73,7 +73,7 @@ by the discretization stencil. Thus the first order of business is to establish an index space, and this is done with a call to psb_cdall in which we specify the size of the index space $n$ and the allocation of the elements of the index space to the various processes making up the MPI (virtual) @@ -82,7 +82,7 @@ parallel machine.

        The index space is partitioned among processes, and this creates a mapping from the ``global'' numbering $1\dots n$ to a numbering ``local'' to each process; each process $1\dots n_{\hbox{row}_i}$, each element of which corresponds to a certain element of $1\dots n$. The user does not set explicitly this mapping; when the application needs to indicate to which element of the index @@ -107,7 +107,7 @@ library will translate into the appropriate ``local'' numbering.

        For a given index space $1\dots n$ there are many possible associated topologies, i.e. many different discretization stencils; thus the @@ -124,7 +124,7 @@ defined a set of ``halo'' (or ``ghost'') indices $n_{\hbox{row}_i}+1\dots n_{\hbox{col}_i}$ --> $n_{\hbox{row}_i}+1\dots n_{\hbox{col}_i}$, denoting elements of the index space that are not assigned to process


        - next - up - previous - contents
        - Next: Next: Programming model - Up: Up: General overview - Previous: Previous: Library contents -   Contents diff --git a/docs/html/node60.html b/docs/html/node60.html index 22fc8cc66..8b978d171 100644 --- a/docs/html/node60.html +++ b/docs/html/node60.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_glob_to_loc -- Global to local indices convertion - +psb_gefree -- Frees a dense matrix + @@ -20,101 +20,80 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_loc_to_glob Local - Up: Data management routines - Previous: psb_gelp Applies -   Next: psb_gelp Applies + Up: Data management routines + Previous: psb_geasb Assembly +   Contents

        -

        -psb_glob_to_loc -- Global to local indices - convertion +

        +psb_gefree -- Frees a dense matrix

        -call psb_glob_to_loc(x, y, desc_a, info, iact,owned)
        -call psb_glob_to_loc(x, desc_a, info, iact,owned)
        +call psb_gefree(x, desc_a, info)
         

        Type:
        -
        Asynchronous. +
        Synchronous.
        On Entry
        x
        -
        An integer vector of indices to be converted. +
        The dense matrix to + be freed.
        Scope: local
        Type: required
        -Intent: in, inout. +Intent: inout.
        -Specified as: a rank one integer array. -
        +Specified as: a rank one or two array with the ALLOCATABLE +attribute, of type real, complex or integer. +
        +

        +

        desc_a
        -
        the communication descriptor. +
        The communication descriptor.
        -Scope:local. +Scope: local
        -Type:required. +Type: required
        Intent: in.
        -Specified as: a structured data of type descdatapsb_desc_type. -
        -
        iact
        -
        specifies action to be taken in case of range errors. -Scope: global -
        -Type: optional -
        -Intent: in. -
        -Specified as: a character variable Ignore, Warning or -Abort, default Ignore. -
        -
        owned
        -
        Specfies valid range of input -Scope: global -
        -Type: optional -
        -Intent: in. -
        -If true, then only indices strictly owned by the current process are -considered valid, if false then halo indices are also -accepted. Default: false. -
        +Specified as: a variable of type descdatapsb_desc_type. +

        @@ -122,44 +101,6 @@ accepted. Default: false.

        On Return
        -
        x
        -
        If $y$ is not present, - then $x$ is overwritten with the translated integer indices. -Scope: global -
        -Type: required -
        -Intent: inout. -
        -Specified as: a rank one integer array. -
        -
        y
        -
        If $y$ is present, - then $y$ is overwritten with the translated integer indices, and $x$ - is left unchanged. -Scope: global -
        -Type: optional -
        -Intent: out. -
        -Specified as: a rank one integer array. -
        info
        Error code.
        @@ -174,42 +115,7 @@ An integer value; 0 means no error has been detected.

        -Notes - -

          -
        1. If an input index is out of range, then the corresponding output - index is set to a negative number; -
        2. -
        3. The default Ignore means that the negative output is the - only action taken on an out-of-range input. -
        4. -
        - -

        -


        - - -next - -up - -previous - -contents -
        - Next: psb_loc_to_glob Local - Up: Data management routines - Previous: psb_gelp Applies -   Contents - +

        diff --git a/docs/html/node61.html b/docs/html/node61.html index 73f74e080..36ee01168 100644 --- a/docs/html/node61.html +++ b/docs/html/node61.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_loc_to_glob -- Local to global indices conversion - +psb_gelp -- Applies a left permutation to a dense matrix + @@ -20,46 +20,45 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_is_owned - Up: Data management routines - Previous: psb_glob_to_loc Global -   Next: psb_glob_to_loc Global + Up: Data management routines + Previous: psb_gefree Frees +   Contents

        -

        -psb_loc_to_glob -- Local to global indices - conversion +

        +psb_gelp -- Applies a left permutation to a dense + matrix

        -call psb_loc_to_glob(x, y, desc_a, info, iact)
        -call psb_loc_to_glob(x, desc_a, info, iact)
        +call psb_gelp(trans, iperm, x, info)
         

        @@ -70,39 +69,51 @@ call psb_loc_to_glob(x, desc_a, info, iact)

        On Entry
        -
        x
        -
        An integer vector of indices to be converted. +
        trans
        +
        A character that specifies whether to permute $A$ or $A^T$.
        Scope: local
        Type: required
        -Intent: in, inout. +Intent: in.
        -Specified as: a rank one integer array. +Specified as: a single character with value 'N' for $A$ or 'T' for $A^T$.
        -
        desc_a
        -
        the communication descriptor. +
        iperm
        +
        An integer array containing permutation information.
        -Scope:local. +Scope: local
        -Type:required. +Type: required
        Intent: in.
        -Specified as: a structured data of type descdatapsb_desc_type. -
        -
        iact
        -
        specifies action to be taken in case of range errors. -Scope: global +Specified as: an integer one-dimensional array. +
        +
        x
        +
        The dense matrix to be permuted.
        -Type: optional +Scope: local
        -Intent: in. +Type: required
        -Specified as: a character variable Ignore, Warning or -Abort, default Ignore. -
        +Intent: inout. +
        +Specified as: a one or two dimensional array. +

        @@ -110,44 +121,6 @@ Specified as: a character variable Ignore, Warning or

        On Return
        -
        x
        -
        If $y$ is not present, - then $x$ is overwritten with the translated integer indices. -Scope: global -
        -Type: required -
        -Intent: inout. -
        -Specified as: a rank one integer array. -
        -
        y
        -
        If $y$ is not present, - then $y$ is overwritten with the translated integer indices, and $x$ - is left unchanged. -Scope: global -
        -Type: optional -
        -Intent: out. -
        -Specified as: a rank one integer array. -
        info
        Error code.
        @@ -162,30 +135,7 @@ An integer value; 0 means no error has been detected.

        -


        - - -next - -up - -previous - -contents -
        - Next: psb_is_owned - Up: Data management routines - Previous: psb_glob_to_loc Global -   Contents - +

        diff --git a/docs/html/node62.html b/docs/html/node62.html index 10f08135b..3ec5cbd70 100644 --- a/docs/html/node62.html +++ b/docs/html/node62.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_is_owned - +psb_glob_to_loc -- Global to local indices convertion + @@ -20,44 +20,46 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_owned_index - Up: Data management routines - Previous: psb_loc_to_glob Local -   Next: psb_loc_to_glob Local + Up: Data management routines + Previous: psb_gelp Applies +   Contents

        -

        -psb_is_owned +

        +psb_glob_to_loc -- Global to local indices + convertion

        -call psb_is_owned(x, desc_a)
        +call psb_glob_to_loc(x, y, desc_a, info, iact,owned)
        +call psb_glob_to_loc(x, desc_a, info, iact,owned)
         

        @@ -69,15 +71,15 @@ call psb_is_owned(x, desc_a)

        x
        -
        Integer index. +
        An integer vector of indices to be converted.
        Scope: local
        Type: required
        -Intent: in. +Intent: in, inout.
        -Specified as: a scalar integer. +Specified as: a rank one integer array.
        desc_a
        the communication descriptor. @@ -90,6 +92,29 @@ Intent: in.
        Specified as: a structured data of type descdatapsb_desc_type.
        +
        iact
        +
        specifies action to be taken in case of range errors. +Scope: global +
        +Type: optional +
        +Intent: in. +
        +Specified as: a character variable Ignore, Warning or +Abort, default Ignore. +
        +
        owned
        +
        Specfies valid range of input +Scope: global +
        +Type: optional +
        +Intent: in. +
        +If true, then only indices strictly owned by the current process are +considered valid, if false then halo indices are also +accepted. Default: false. +

        @@ -97,32 +122,94 @@ Specified as: a structured data of type descdatapsb_desc_type.

        On Return
        -
        Function value
        -
        A logical mask which is true if - $x$ is owned by the current process -Scope: local +
        x
        +
        If $y$ is not present, + then $x$ is overwritten with the translated integer indices. +Scope: global
        Type: required
        +Intent: inout. +
        +Specified as: a rank one integer array. +
        +
        y
        +
        If $y$ is present, + then $y$ is overwritten with the translated integer indices, and $x$ + is left unchanged. +Scope: global +
        +Type: optional +
        Intent: out. -
        +
        +Specified as: a rank one integer array. + +
        info
        +
        Error code. +
        +Scope: local +
        +Type: required +
        +Intent: out. +
        +An integer value; 0 means no error has been detected. +

        Notes

          -
        1. This routine returns a .true. value for an index - that is strictly owned by the current process, excluding the halo - indices +
        2. If an input index is out of range, then the corresponding output + index is set to a negative number; +
        3. +
        4. The default Ignore means that the negative output is the + only action taken on an out-of-range input.

        -


        +
        + + +next + +up + +previous + +contents +
        + Next: psb_loc_to_glob Local + Up: Data management routines + Previous: psb_gelp Applies +   Contents + diff --git a/docs/html/node63.html b/docs/html/node63.html index dee24c7f7..02adc2085 100644 --- a/docs/html/node63.html +++ b/docs/html/node63.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_owned_index - +psb_loc_to_glob -- Local to global indices conversion + @@ -20,44 +20,46 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_is_local - Up: Data management routines - Previous: psb_is_owned -   Next: psb_is_owned + Up: Data management routines + Previous: psb_glob_to_loc Global +   Contents

        -

        -psb_owned_index +

        +psb_loc_to_glob -- Local to global indices + conversion

        -call psb_owned_index(y, x, desc_a, info)
        +call psb_loc_to_glob(x, y, desc_a, info, iact)
        +call psb_loc_to_glob(x, desc_a, info, iact)
         

        @@ -69,7 +71,7 @@ call psb_owned_index(y, x, desc_a, info)

        x
        -
        Integer indices. +
        An integer vector of indices to be converted.
        Scope: local
        @@ -77,7 +79,7 @@ Type: required
        Intent: in, inout.
        -Specified as: a scalar or a rank one integer array. +Specified as: a rank one integer array.
        desc_a
        the communication descriptor. @@ -108,19 +110,43 @@ Specified as: a character variable Ignore, Warning or
        On Return
        -
        y
        -
        A logical mask which is true for all corresponding entries of - $x$ that are owned by the current process -Scope: local +
        x
        +
        If $y$ is not present, + then $x$ is overwritten with the translated integer indices. +Scope: global
        Type: required
        +Intent: inout. +
        +Specified as: a rank one integer array. +
        +
        y
        +
        If $y$ is not present, + then $y$ is overwritten with the translated integer indices, and $x$ + is left unchanged. +Scope: global +
        +Type: optional +
        Intent: out.
        -Specified as: a scalar or rank one logical array. +Specified as: a rank one integer array.
        info
        Error code. @@ -136,17 +162,30 @@ An integer value; 0 means no error has been detected.

        -Notes - -

          -
        1. This routine returns a .true. value for those indices - that are strictly owned by the current process, excluding the halo - indices -
        2. -
        - -

        -


        +
        + + +next + +up + +previous + +contents +
        + Next: psb_is_owned + Up: Data management routines + Previous: psb_glob_to_loc Global +   Contents + diff --git a/docs/html/node64.html b/docs/html/node64.html index 4b676ab3e..edf09ef0f 100644 --- a/docs/html/node64.html +++ b/docs/html/node64.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_is_local - +psb_is_owned + @@ -20,44 +20,44 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_local_index - Up: Data management routines - Previous: psb_owned_index -   Next: psb_owned_index + Up: Data management routines + Previous: psb_loc_to_glob Local +   Contents

        -

        -psb_is_local +

        +psb_is_owned

        -call psb_is_local(x, desc_a)
        +call psb_is_owned(x, desc_a)
         

        @@ -100,9 +100,9 @@ Specified as: a structured data of type descdatapsb_desc_type.

        Function value
        A logical mask which is true if $x$ is local to the current process + WIDTH="13" HEIGHT="14" ALIGN="BOTTOM" BORDER="0" + SRC="img28.png" + ALT="$x$"> is owned by the current process Scope: local
        Type: required @@ -116,7 +116,7 @@ Intent: out.
        1. This routine returns a .true. value for an index - that is local to the current process, including the halo + that is strictly owned by the current process, excluding the halo indices
        diff --git a/docs/html/node65.html b/docs/html/node65.html index 3f2a6af92..cbabc7138 100644 --- a/docs/html/node65.html +++ b/docs/html/node65.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_local_index - +psb_owned_index + @@ -20,44 +20,44 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_get_boundary Extract - Up: Data management routines - Previous: psb_is_local -   Next: psb_is_local + Up: Data management routines + Previous: psb_is_owned +   Contents

        -

        -psb_local_index +

        +psb_owned_index

        -call psb_local_index(y, x, desc_a, info)
        +call psb_owned_index(y, x, desc_a, info)
         

        @@ -111,9 +111,9 @@ Specified as: a character variable Ignore, Warning or

        y
        A logical mask which is true for all corresponding entries of $x$ that are local to the current process + WIDTH="13" HEIGHT="14" ALIGN="BOTTOM" BORDER="0" + SRC="img28.png" + ALT="$x$"> that are owned by the current process Scope: local
        Type: required @@ -140,8 +140,8 @@ An integer value; 0 means no error has been detected.
        1. This routine returns a .true. value for those indices - that are local to the current process, including the halo - indices. + that are strictly owned by the current process, excluding the halo + indices
        diff --git a/docs/html/node66.html b/docs/html/node66.html index d5292eb1a..7e4a7d06d 100644 --- a/docs/html/node66.html +++ b/docs/html/node66.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_get_boundary -- Extract list of boundary elements - +psb_is_local + @@ -20,44 +20,44 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_get_overlap Extract - Up: Data management routines - Previous: psb_local_index -   Next: psb_local_index + Up: Data management routines + Previous: psb_owned_index +   Contents

        -

        -psb_get_boundary -- Extract list of boundary elements +

        +psb_is_local

        -call psb_get_boundary(bndel, desc, info)
        +call psb_is_local(x, desc_a)
         

        @@ -68,7 +68,18 @@ call psb_get_boundary(bndel, desc, info)

        On Entry
        -
        desc
        +
        x
        +
        Integer index. +
        +Scope: local +
        +Type: required +
        +Intent: in. +
        +Specified as: a scalar integer. +
        +
        desc_a
        the communication descriptor.
        Scope:local. @@ -86,42 +97,27 @@ Specified as: a structured data of type descdatapsb_desc_type.
        On Return
        -
        bndel
        -
        The list of boundary elements on the calling process, in - local numbering. -
        +
        Function value
        +
        A logical mask which is true if + $x$ is local to the current process Scope: local
        Type: required
        Intent: out. -
        -Specified as: a rank one array with the ALLOCATABLE -attribute, of type integer.
        -
        info
        -
        Error code. -
        -Scope: local -
        -Type: required -
        -Intent: out. -
        -An integer value; 0 means no error has been detected. -

        Notes

          -
        1. If there are no boundary elements (i.e., if the local part of - the connectivity graph is self-contained) the output vector is set - to the ``not allocated'' state. -
        2. -
        3. Otherwise the size of bndel will be exactly equal to the - number of boundary elements. +
        4. This routine returns a .true. value for an index + that is local to the current process, including the halo + indices
        diff --git a/docs/html/node67.html b/docs/html/node67.html index 77247f39c..51d159381 100644 --- a/docs/html/node67.html +++ b/docs/html/node67.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_get_overlap -- Extract list of overlap elements - +psb_local_index + @@ -20,44 +20,44 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_sp_getrow Extract - Up: Data management routines - Previous: psb_get_boundary Extract -   Next: psb_get_boundary Extract + Up: Data management routines + Previous: psb_is_local +   Contents

        -

        -psb_get_overlap -- Extract list of overlap elements +

        +psb_local_index

        -call psb_get_overlap(ovrel, desc, info)
        +call psb_local_index(y, x, desc_a, info)
         

        @@ -68,7 +68,18 @@ call psb_get_overlap(ovrel, desc, info)

        On Entry
        -
        desc
        +
        x
        +
        Integer indices. +
        +Scope: local +
        +Type: required +
        +Intent: in, inout. +
        +Specified as: a scalar or a rank one integer array. +
        +
        desc_a
        the communication descriptor.
        Scope:local. @@ -79,6 +90,17 @@ Intent: in.
        Specified as: a structured data of type descdatapsb_desc_type.
        +
        iact
        +
        specifies action to be taken in case of range errors. +Scope: global +
        +Type: optional +
        +Intent: in. +
        +Specified as: a character variable Ignore, Warning or +Abort, default Ignore. +

        @@ -86,19 +108,20 @@ Specified as: a structured data of type descdatapsb_desc_type.

        On Return
        -
        ovrel
        -
        The list of overlap elements on the calling process, in - local numbering. -
        +
        y
        +
        A logical mask which is true for all corresponding entries of + $x$ that are local to the current process Scope: local
        Type: required
        Intent: out.
        -Specified as: a rank one array with the ALLOCATABLE -attribute, of type integer. -
        +Specified as: a scalar or rank one logical array. +
        info
        Error code.
        @@ -116,11 +139,9 @@ An integer value; 0 means no error has been detected. Notes
          -
        1. If there are no overlap elements the output vector is set - to the ``not allocated'' state. -
        2. -
        3. Otherwise the size of ovrel will be exactly equal to the - number of overlap elements. +
        4. This routine returns a .true. value for those indices + that are local to the current process, including the halo + indices.
        diff --git a/docs/html/node68.html b/docs/html/node68.html index 94d1ec7b2..f7683aa0c 100644 --- a/docs/html/node68.html +++ b/docs/html/node68.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_sp_getrow -- Extract row(s) from a sparse matrix - +psb_get_boundary -- Extract list of boundary elements + @@ -20,45 +20,44 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_sizeof Memory - Up: Data management routines - Previous: psb_get_overlap Extract -   Next: psb_get_overlap Extract + Up: Data management routines + Previous: psb_local_index +   Contents

        -

        -psb_sp_getrow -- Extract row(s) from a sparse matrix +

        +psb_get_boundary -- Extract list of boundary elements

        -call psb_sp_getrow(row, a, nz, ia, ja, val, info, &
        -              & append, nzin, lrw)
        +call psb_get_boundary(bndel, desc, info)
         

        @@ -69,75 +68,16 @@ call psb_sp_getrow(row, a, nz, ia, ja, val, info, &

        On Entry
        -
        row
        -
        The (first) row to be extracted. +
        desc
        +
        the communication descriptor.
        -Scope:local +Scope:local.
        -Type:required +Type:required.
        Intent: in.
        -Specified as: an integer $>0$. -
        -
        a
        -
        the matrix from which to get rows. -
        -Scope:local -
        -Type:required -
        -Intent: in. -
        -Specified as: a structured data of type spdatapsb_spmat_type. -
        -
        append
        -
        Whether to append or overwrite existing output. -
        -Scope:local -
        -Type:optional -
        -Intent: in. -
        -Specified as: a logical value default: false (overwrite). -
        -
        nzin
        -
        Input size to be appended to. -
        -Scope:local -
        -Type:optional -
        -Intent: in. -
        -Specified as: an integer $>0$. When append is true, specifies how many -entries in the output vectors are already filled. -
        -
        lrw
        -
        The last row to be extracted. -
        -Scope:local -
        -Type:optional -
        -Intent: in. -
        -Specified as: an integer $>0$, default: $row$. - -

        +Specified as: a structured data of type descdatapsb_desc_type.

        @@ -146,50 +86,19 @@ Specified as: an integer On Return
        -
        nz
        -
        the number of elements returned by this call. +
        bndel
        +
        The list of boundary elements on the calling process, in + local numbering.
        -Scope:local. +Scope: local
        -Type:required. +Type: required
        Intent: out.
        -Returned as: an integer scalar. -
        -
        ia
        -
        the row indices. -
        -Scope:local. -
        -Type:required. -
        -Intent: inout. -
        -Specified as: an integer array with the ALLOCATABLE attribute. -
        -
        ja
        -
        the column indices of the elements to be inserted. -
        -Scope:local. -
        -Type:required. -
        -Intent: inout. -
        -Specified as: an integer array with the ALLOCATABLE attribute. -
        -
        val
        -
        the elements to be inserted. -
        -Scope:local. -
        -Type:required. -
        -Intent: inout. -
        -Specified as: a real array with the ALLOCATABLE attribute. -
        +Specified as: a rank one array with the ALLOCATABLE +attribute, of type integer. +
        info
        Error code.
        @@ -207,51 +116,17 @@ An integer value; 0 means no error has been detected. Notes
          -
        1. The output $nz$ is always the size of the output generated by - the current call; thus, if append=.true., the total output - size will be $nzin+nz$, with the newly extracted coefficients stored in - entries nzin+1:nzin+nz of the array arguments; +
        2. If there are no boundary elements (i.e., if the local part of + the connectivity graph is self-contained) the output vector is set + to the ``not allocated'' state.
        3. -
        4. When append=.true. the output arrays are reallocated as - necessary; -
        5. -
        6. The row and column indices are returned in the local numbering - scheme; if the global numbering is desired, the user may employ the - psb_loc_to_glob routine on the output. +
        7. Otherwise the size of bndel will be exactly equal to the + number of boundary elements.

        -


        - - -next - -up - -previous - -contents -
        - Next: psb_sizeof Memory - Up: Data management routines - Previous: psb_get_overlap Extract -   Contents - +

        diff --git a/docs/html/node69.html b/docs/html/node69.html index a8c6ba2c9..c63d8c80e 100644 --- a/docs/html/node69.html +++ b/docs/html/node69.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_sizeof -- Memory occupation - +psb_get_overlap -- Extract list of overlap elements + @@ -20,49 +20,44 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: Sorting utilities - Up: Data management routines - Previous: psb_sp_getrow Extract -   Next: psb_sp_getrow Extract + Up: Data management routines + Previous: psb_get_boundary Extract +   Contents

        -

        -psb_sizeof -- Memory occupation +

        +psb_get_overlap -- Extract list of overlap elements

        -

        -This function computes the memory occupation of a PSBLAS object. -

        -isz = psb_sizeof(a)
        -isz = psb_sizeof(desc_a)
        -isz = psb_sizeof(prec)
        +call psb_get_overlap(ovrel, desc, info)
         

        @@ -73,54 +68,62 @@ isz = psb_sizeof(prec)

        On Entry
        -
        a
        -
        A sparse matrix -$A$. +
        desc
        +
        the communication descriptor.
        -Scope: local +Scope:local.
        -Type: required -
        -Intent: in. -
        -Specified as: a structured data of type spdatapsb_spmat_type. -
        -
        desc_a
        -
        Communication descriptor. -
        -Scope: local -
        -Type: required +Type:required.
        Intent: in.
        Specified as: a structured data of type descdatapsb_desc_type.
        -
        prec
        -
        Scope: local -
        -Type: required -
        -Intent: in. -
        -Specified as: a preconditioner data structure precdatapsb_prec_type. -
        + + +

        +

        On Return
        -
        Function value
        -
        The memory occupation of the object specified in - the calling sequence, in bytes. +
        ovrel
        +
        The list of overlap elements on the calling process, in + local numbering.
        Scope: local
        -Returned as: an integer(psb_long_int_k_) number. +Type: required +
        +Intent: out. +
        +Specified as: a rank one array with the ALLOCATABLE +attribute, of type integer. +
        +
        info
        +
        Error code. +
        +Scope: local +
        +Type: required +
        +Intent: out. +
        +An integer value; 0 means no error has been detected.
        +

        +Notes + +

          +
        1. If there are no overlap elements the output vector is set + to the ``not allocated'' state. +
        2. +
        3. Otherwise the size of ovrel will be exactly equal to the + number of overlap elements. +
        4. +
        +



        diff --git a/docs/html/node7.html b/docs/html/node7.html index 388b2fbb2..182e2bd39 100644 --- a/docs/html/node7.html +++ b/docs/html/node7.html @@ -25,26 +25,26 @@ original version by: Nikos Drakos, CBLU, University of Leeds - next - up - previous - contents
        - Next: Next: Data Structures - Up: Up: General overview - Previous: Previous: Application structure -   Contents

        @@ -72,7 +72,7 @@ the tools routines.

        However there are many cases where no synchronization, and indeed no communication among processes, is implied; for instance, all the routines in -sec. 3.4 are only acting on the local data structures, +sec. 3.5 are only acting on the local data structures, and thus may be called independently. The most important case is that of the coefficient insertion routines: since the number of coefficients in the sparse and dense matrices varies among the @@ -96,26 +96,26 @@ as:


        - next - up - previous - contents
        - Next: Next: Data Structures - Up: Up: General overview - Previous: Previous: Application structure -   Contents diff --git a/docs/html/node70.html b/docs/html/node70.html index 3307b92c4..71cb73cb5 100644 --- a/docs/html/node70.html +++ b/docs/html/node70.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -Sorting utilities - +psb_sp_getrow -- Extract row(s) from a sparse matrix + @@ -18,118 +18,124 @@ original version by: Nikos Drakos, CBLU, University of Leeds + - + - next - + up - previous - contents
        - Next: Parallel environment routines - Up: Data management routines - Previous: psb_sizeof Memory -   Next: psb_sizeof Memory + Up: Data management routines + Previous: psb_get_overlap Extract +   Contents

        -

        -Sorting utilities +

        +psb_sp_getrow -- Extract row(s) from a sparse matrix

        -psb_msort -- Sorting by the Merge-sort - algorithm - -

        -psb_qsort -- Sorting by the Quicksort - algorithm - -

        -psb_hsort -- Sorting by the Heapsort algorithm

        -call psb_msort(x,ix,dir,flag)
        -call psb_qsort(x,ix,dir,flag)
        -call psb_hsort(x,ix,dir,flag)
        +call psb_sp_getrow(row, a, nz, ia, ja, val, info, &
        +              & append, nzin, lrw)
         

        -These serial routines sort a sequence $X$ into ascending or -descending order. The argument meaning is identical for the three -calls; the only difference is the algorithm used to accomplish the -task (see Usage Notes below).

        Type:
        Asynchronous.
        -
        On Entry
        +
        On Entry
        -
        x
        -
        The sequence to be sorted. +
        row
        +
        The (first) row to be extracted.
        -Type:required. +Scope:local
        -Specified as: an integer, real or complex array of rank 1. +Type:required +
        +Intent: in. +
        +Specified as: an integer $>0$.
        -
        ix
        -
        A vector of indices. +
        a
        +
        the matrix from which to get rows.
        -Type:optional. +Scope:local
        -Specified as: an integer array of (at least) the same size as $X$. +Type:required +
        +Intent: in. +
        +Specified as: a structured data of type spdatapsb_spmat_type.
        -
        dir
        -
        The desired ordering. +
        append
        +
        Whether to append or overwrite existing output.
        -Type:optional. +Scope:local
        -Specified as: an integer value:
        -
        Integer and real data:
        -
        psb_sort_up_, -psb_sort_down_, psb_asort_up_, psb_asort_down_; -default psb_sort_up_. +Type:optional +
        +Intent: in. +
        +Specified as: a logical value default: false (overwrite).
        -
        Complex data:
        -
        psb_lsort_up_, -psb_lsort_down_, psb_asort_up_, psb_asort_down_; -default psb_lsort_up_. -
        -
        -
        -
        flag
        -
        Whether to keep the original values in $IX$. +
        nzin
        +
        Input size to be appended to.
        -Type:optional. +Scope:local
        -Specified as: an integer value psb_sort_ovw_idx_ or -psb_sort_keep_idx_; default psb_sort_ovw_idx_. +Type:optional +
        +Intent: in. +
        +Specified as: an integer $>0$. When append is true, specifies how many +entries in the output vectors are already filled. +
        +
        lrw
        +
        The last row to be extracted. +
        +Scope:local +
        +Type:optional +
        +Intent: in. +
        +Specified as: an integer $>0$, default: $row$.

        @@ -140,152 +146,110 @@ Specified as: an integer value psb_sort_ovw_idx_ or
        On Return
        -
        x
        -
        The sequence of values, in the chosen ordering. +
        nz
        +
        the number of elements returned by this call. +
        +Scope:local.
        Type:required.
        -Specified as: an integer, real or complex array of rank 1. +Intent: out. +
        +Returned as: an integer scalar.
        -
        ix
        -
        A vector of indices. +
        ia
        +
        the row indices.
        -Type: Optional +Scope:local.
        -An integer array of rank 1, whose entries are moved to the same -position as the corresponding entries in $x$. +Type:required. +
        +Intent: inout. +
        +Specified as: an integer array with the ALLOCATABLE attribute. +
        +
        ja
        +
        the column indices of the elements to be inserted. +
        +Scope:local. +
        +Type:required. +
        +Intent: inout. +
        +Specified as: an integer array with the ALLOCATABLE attribute. +
        +
        val
        +
        the elements to be inserted. +
        +Scope:local. +
        +Type:required. +
        +Intent: inout. +
        +Specified as: a real array with the ALLOCATABLE attribute. +
        +
        info
        +
        Error code. +
        +Scope: local +
        +Type: required +
        +Intent: out. +
        +An integer value; 0 means no error has been detected.
        -

        -

        Notes

          -
        1. For integer or real data the sorting can be performed in the up/down direction, on the - natural or absolute values; +
        2. The output $nz$ is always the size of the output generated by + the current call; thus, if append=.true., the total output + size will be $nzin+nz$, with the newly extracted coefficients stored in + entries nzin+1:nzin+nz of the array arguments;
        3. -
        4. For complex data the sorting can be done in a lexicographic - order (i.e.: sort on the real part with ties broken according to - the imaginary part) or on the absolute values; +
        5. When append=.true. the output arrays are reallocated as + necessary;
        6. -
        7. The routines return the items in the chosen ordering; the - output difference is the handling of ties (i.e. items with an - equal value) in the original input. With the merge-sort algorithm - ties are preserved in the same relative order as they had in the - original sequence, while this is not guaranteed for quicksort or - heapsort; -
        8. -
        9. If -$flag = psb\_sort\_ovw\_idx\_$ then the entries in $ix(1:n)$ - where $n$ is the size of $x$ are initialized to -$ix(i) \leftarrow
-i$; thus, upon return from the subroutine, for each - index $i$ we have in $ix(i)$ the position that the item $x(i)$ - occupied in the original data sequence; -
        10. -
        11. If -$flag = psb\_sort\_keep\_idx\_$ the routine will assume that - the entries in $ix(:)$ have already been initialized by the user; -
        12. -
        13. The three sorting algorithms have a similar $O(n \log n)$ expected - running time; in the average case quicksort will be the - fastest and merge-sort the slowest. However note that: - -
            -
          1. The worst case running time for quicksort is $O(n^2)$; the algorithm - implemented here follows the well-known median-of-three heuristics, - but the worst case may still apply; -
          2. -
          3. The worst case running time for merge-sort and heap-sort is - $O(n \log n)$ as the average case; -
          4. -
          5. The merge-sort algorithm is implemented to take advantage of - subsequences that may be already in the desired ordering prior to - the subroutine call; this situation is relatively common when - dealing with groups of indices of sparse matrix entries, thus - merge-sort is often the preferred choice when a sorting is needed - by other routines in the library. +
          6. The row and column indices are returned in the local numbering + scheme; if the global numbering is desired, the user may employ the + psb_loc_to_glob routine on the output.
          -
        14. -
        - -


        - next - + up - previous - contents
        - Next: Parallel environment routines - Up: Data management routines - Previous: psb_sizeof Memory -   Next: psb_sizeof Memory + Up: Data management routines + Previous: psb_get_overlap Extract +   Contents diff --git a/docs/html/node71.html b/docs/html/node71.html index 639f75374..1c34bc51e 100644 --- a/docs/html/node71.html +++ b/docs/html/node71.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -Parallel environment routines - +psb_sizeof -- Memory occupation + @@ -18,87 +18,110 @@ original version by: Nikos Drakos, CBLU, University of Leeds - - - + + + - next - + up - previous - contents
        - Next: psb_init Initializes - Up: userhtml - Previous: Sorting utilities -   Next: Sorting utilities + Up: Data management routines + Previous: psb_sp_getrow Extract +   Contents

        -

        - -
        -Parallel environment routines -

        +

        +psb_sizeof -- Memory occupation +

        -


        - -Subsections +This function computes the memory occupation of a PSBLAS object. - - +

        +

        +isz = psb_sizeof(a)
        +isz = psb_sizeof(desc_a)
        +isz = psb_sizeof(prec)
        +
        + +

        +

        +
        Type:
        +
        Asynchronous. +
        +
        On Entry
        +
        +
        +
        a
        +
        A sparse matrix +$A$. +
        +Scope: local +
        +Type: required +
        +Intent: in. +
        +Specified as: a structured data of type spdatapsb_spmat_type. +
        +
        desc_a
        +
        Communication descriptor. +
        +Scope: local +
        +Type: required +
        +Intent: in. +
        +Specified as: a structured data of type descdatapsb_desc_type. +
        +
        prec
        +
        Scope: local +
        +Type: required +
        +Intent: in. +
        +Specified as: a preconditioner data structure precdatapsb_prec_type. +
        +
        On Return
        +
        +
        +
        Function value
        +
        The memory occupation of the object specified in + the calling sequence, in bytes. +
        +Scope: local +
        +Returned as: an integer(psb_long_int_k_) number. +
        +
        + +



        diff --git a/docs/html/node72.html b/docs/html/node72.html index 7c6989ae4..dd9331c46 100644 --- a/docs/html/node72.html +++ b/docs/html/node72.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_init -- Initializes PSBLAS parallel environment - +Sorting utilities + @@ -18,97 +18,120 @@ original version by: Nikos Drakos, CBLU, University of Leeds - - + - next - + up - previous - contents
        - Next: psb_info Return - Up: Parallel environment routines - Previous: Parallel environment routines -   Next: Parallel environment routines + Up: Data management routines + Previous: psb_sizeof Memory +   Contents

        -

        -psb_init -- Initializes PSBLAS parallel environment +

        +Sorting utilities

        +psb_msort -- Sorting by the Merge-sort + algorithm + +

        +psb_qsort -- Sorting by the Quicksort + algorithm + +

        +psb_hsort -- Sorting by the Heapsort algorithm

        -call psb_init(icontxt, np, basectxt, ids)
        +call psb_msort(x,ix,dir,flag)
        +call psb_qsort(x,ix,dir,flag)
        +call psb_hsort(x,ix,dir,flag)
         

        -This subroutine initializes the PSBLAS parallel environment, defining -a virtual parallel machine. +These serial routines sort a sequence $X$ into ascending or +descending order. The argument meaning is identical for the three +calls; the only difference is the algorithm used to accomplish the +task (see Usage Notes below).

        Type:
        -
        Synchronous. +
        Asynchronous.
        On Entry
        -
        np
        -
        Number of processes in the PSBLAS virtual parallel machine. +
        x
        +
        The sequence to be sorted.
        -Scope: global. +Type:required.
        -Type: optional. -
        -Intent: in. -
        -Specified as: an integer value. Default: use all available processes. +Specified as: an integer, real or complex array of rank 1.
        -
        basectxt
        -
        the initial communication context. The new context - will be defined from the processes participating in the initial one. +
        ix
        +
        A vector of indices.
        -Scope: global. +Type:optional.
        -Type: optional. -
        -Intent: in. -
        -Specified as: an integer value. Default: use MPI_COMM_WORLD. +Specified as: an integer array of (at least) the same size as $X$.
        -
        ids
        -
        Identities of the processes to use for the new context; the - argument is ignored when np is not specified. This allows the - processes in the new environment to be in an order different from the - original one. +
        dir
        +
        The desired ordering.
        -Scope: global. +Type:optional.
        -Type: optional. +Specified as: an integer value:
        +
        Integer and real data:
        +
        psb_sort_up_, +psb_sort_down_, psb_asort_up_, psb_asort_down_; +default psb_sort_up_. +
        +
        Complex data:
        +
        psb_lsort_up_, +psb_lsort_down_, psb_asort_up_, psb_asort_down_; +default psb_lsort_up_. +
        +
        +
        +
        flag
        +
        Whether to keep the original values in $IX$.
        -Intent: in. +Type:optional.
        -Specified as: an integer array. Default: use the indices $(0\dots np-1)$. +Specified as: an integer value psb_sort_ovw_idx_ or +psb_sort_keep_idx_; default psb_sort_ovw_idx_. + +

        @@ -117,60 +140,152 @@ Specified as: an integer array. Default: use the indices On Return
        -
        icontxt
        -
        the communication context identifying the virtual - parallel machine. Note that this is always a duplicate of - basectxt, so that library communications are completely - separated from other communication operations. +
        x
        +
        The sequence of values, in the chosen ordering.
        -Scope: global. +Type:required.
        -Type: required. +Specified as: an integer, real or complex array of rank 1. +
        +
        ix
        +
        A vector of indices.
        -Intent: out. +Type: Optional
        -Specified as: an integer variable. +An integer array of rank 1, whose entries are moved to the same +position as the corresponding entries in $x$.
        +

        +

        Notes

          -
        1. A call to this routine must precede any other PSBLAS call. +
        2. For integer or real data the sorting can be performed in the up/down direction, on the + natural or absolute values;
        3. -
        4. It is an error to specify a value for For complex data the sorting can be done in a lexicographic + order (i.e.: sort on the real part with ties broken according to + the imaginary part) or on the absolute values; +
        5. +
        6. The routines return the items in the chosen ordering; the + output difference is the handling of ties (i.e. items with an + equal value) in the original input. With the merge-sort algorithm + ties are preserved in the same relative order as they had in the + original sequence, while this is not guaranteed for quicksort or + heapsort; +
        7. +
        8. If +$flag = psb\_sort\_ovw\_idx\_$ then the entries in $ix(1:n)$ + where $n$ is the size of $x$ are initialized to +$ix(i) \leftarrow
+i$; thus, upon return from the subroutine, for each + index $i$ we have in $ix(i)$ the position that the item $x(i)$ + occupied in the original data sequence; +
        9. +
        10. If +$flag = psb\_sort\_keep\_idx\_$ the routine will assume that + the entries in $ix(:)$ have already been initialized by the user; +
        11. +
        12. The three sorting algorithms have a similar $O(n \log n)$ expected + running time; in the average case quicksort will be the + fastest and merge-sort the slowest. However note that: + +
            +
          1. The worst case running time for quicksort is $np$ greater than the - number of processes available in the underlying base parallel - environment. + ALT="$O(n^2)$">; the algorithm + implemented here follows the well-known median-of-three heuristics, + but the worst case may still apply; +
          2. +
          3. The worst case running time for merge-sort and heap-sort is + $O(n \log n)$ as the average case; +
          4. +
          5. The merge-sort algorithm is implemented to take advantage of + subsequences that may be already in the desired ordering prior to + the subroutine call; this situation is relatively common when + dealing with groups of indices of sparse matrix entries, thus + merge-sort is often the preferred choice when a sorting is needed + by other routines in the library. +
          6. +
        +

        +


        - next - + up - previous - contents
        - Next: psb_info Return - Up: Parallel environment routines - Previous: Parallel environment routines -   Next: Parallel environment routines + Up: Data management routines + Previous: psb_sizeof Memory +   Contents diff --git a/docs/html/node73.html b/docs/html/node73.html index 045249c82..1a5b74339 100644 --- a/docs/html/node73.html +++ b/docs/html/node73.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_info -- Return information about PSBLAS parallel environment - +Parallel environment routines + @@ -18,155 +18,88 @@ original version by: Nikos Drakos, CBLU, University of Leeds - - - + + + - next - + up - previous - contents
        - Next: psb_exit Exit - Up: Parallel environment routines - Previous: psb_init Initializes -   Next: psb_init Initializes + Up: userhtml + Previous: Sorting utilities +   Contents

        -

        -psb_info -- Return information about PSBLAS parallel +

        + +
        +Parallel environment routines +

        + +

        +


        + +Subsections + +

        - -

        -

        -call psb_info(icontxt, iam, np)
        -
        - -

        -This subroutine returns information about the PSBLAS parallel environment, defining -a virtual parallel machine. -

        -
        Type:
        -
        Asynchronous. -
        -
        On Entry
        -
        -
        -
        icontxt
        -
        the communication context identifying the virtual - parallel machine. -
        -Scope: global. -
        -Type: required. -
        -Intent: in. -
        -Specified as: an integer variable. -
        -
        - -

        -

        -
        On Return
        -
        -
        -
        iam
        -
        Identifier of current process in the PSBLAS virtual parallel machine. -
        -Scope: local. -
        -Type: required. -
        -Intent: out. -
        -Specified as: an integer value. -$-1 \le iam \le np-1$
        -
        np
        -
        Number of processes in the PSBLAS virtual parallel machine. -
        -Scope: global. -
        -Type: required. -
        -Intent: out. -
        -Specified as: an integer variable.
        -
        - -

        -Notes - -

          -
        1. For processes in the virtual parallel machine the identifier - will satisfy -$0 \le iam \le np-1$; -
        2. -
        3. If the user has requested on psb_init a number of - processes less than the total available in the parallel execution - environment, the remaining processes will have on return $iam=-1$; - the only call involving icontxt that any such process may - execute is to psb_exit. -
        4. -
        - -

        -


        - - -next - -up - -previous - -contents -
        - Next: psb_exit Exit - Up: Parallel environment routines - Previous: psb_init Initializes -   Contents - +
      • psb_exit -- Exit from PSBLAS parallel environment +
      • psb_get_mpicomm -- Get the MPI communicator +
      • psb_get_rank -- Get the MPI rank +
      • psb_wtime -- Wall clock timing +
      • psb_barrier -- Sinchronization point parallel + environment +
      • psb_abort -- Abort a computation +
      • psb_bcast -- Broadcast data +
      • psb_sum -- Global sum +
      • psb_max -- Global maximum +
      • psb_min -- Global minimum +
      • psb_amx -- Global maximum absolute value +
      • psb_amn -- Global minimum absolute value +
      • psb_snd -- Send data +
      • psb_rcv -- Receive data + + +

        diff --git a/docs/html/node74.html b/docs/html/node74.html index 0a28df936..a5490e317 100644 --- a/docs/html/node74.html +++ b/docs/html/node74.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_exit -- Exit from PSBLAS parallel environment - +psb_init -- Initializes PSBLAS parallel environment + @@ -20,49 +20,49 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_get_mpicomm Get - Up: Parallel environment routines - Previous: psb_info Return -   Next: psb_info Return + Up: Parallel environment routines + Previous: Parallel environment routines +   Contents

        -

        -psb_exit -- Exit from PSBLAS parallel environment +

        +psb_init -- Initializes PSBLAS parallel environment

        -call psb_exit(icontxt)
        -call psb_exit(icontxt,close)
        +call psb_init(icontxt, np, basectxt, ids)
         

        -This subroutine exits from the PSBLAS parallel virtual machine. +This subroutine initializes the PSBLAS parallel environment, defining +a virtual parallel machine.

        Type:
        Synchronous. @@ -70,21 +70,8 @@ This subroutine exits from the PSBLAS parallel virtual machine.
        On Entry
        -
        icontxt
        -
        the communication context identifying the virtual - parallel machine. -
        -Scope: global. -
        -Type: required. -
        -Intent: in. -
        -Specified as: an integer variable. -
        -
        close
        -
        Whether to close all data structures related to the - virtual parallel machine, besides those associated with icontxt. +
        np
        +
        Number of processes in the PSBLAS virtual parallel machine.
        Scope: global.
        @@ -92,7 +79,57 @@ Type: optional.
        Intent: in.
        -Specified as: a logical variable, default value: true. +Specified as: an integer value. Default: use all available processes. +
        +
        basectxt
        +
        the initial communication context. The new context + will be defined from the processes participating in the initial one. +
        +Scope: global. +
        +Type: optional. +
        +Intent: in. +
        +Specified as: an integer value. Default: use MPI_COMM_WORLD. +
        +
        ids
        +
        Identities of the processes to use for the new context; the + argument is ignored when np is not specified. This allows the + processes in the new environment to be in an order different from the + original one. +
        +Scope: global. +
        +Type: optional. +
        +Intent: in. +
        +Specified as: an integer array. Default: use the indices $(0\dots np-1)$. +
        +
        + +

        +

        +
        On Return
        +
        +
        +
        icontxt
        +
        the communication context identifying the virtual + parallel machine. Note that this is always a duplicate of + basectxt, so that library communications are completely + separated from other communication operations. +
        +Scope: global. +
        +Type: required. +
        +Intent: out. +
        +Specified as: an integer variable.
        @@ -100,49 +137,40 @@ Specified as: a logical variable, default value: true. Notes
          -
        1. This routine may be called even if a previous call to - psb_info has returned with $iam=-1$; indeed, it it is the only - routine that may be called with argument icontxt in this - situation. +
        2. A call to this routine must precede any other PSBLAS call.
        3. -
        4. A call to this routine with close=.true. implies a call - to MPI_Finalize, after which no parallel routine may be called. -
        5. -
        6. If the user whishes to use multiple communication contexts in the - same program, or to enter and exit multiple times into the parallel - environment, this routine may be called to - selectively close the contexts with close=.false., while on - the last call it should be called with close=.true. to - shutdown in a clean way the entire parallel environment. +
        7. It is an error to specify a value for $np$ greater than the + number of processes available in the underlying base parallel + environment.


        - next - + up - previous - contents
        - Next: psb_get_mpicomm Get - Up: Parallel environment routines - Previous: psb_info Return -   Next: psb_info Return + Up: Parallel environment routines + Previous: Parallel environment routines +   Contents diff --git a/docs/html/node75.html b/docs/html/node75.html index ebec206fe..6284718fa 100644 --- a/docs/html/node75.html +++ b/docs/html/node75.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_get_mpicomm -- Get the MPI communicator - +psb_info -- Return information about PSBLAS parallel environment + @@ -20,48 +20,50 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_get_rank Get - Up: Parallel environment routines - Previous: psb_exit Exit -   Next: psb_exit Exit + Up: Parallel environment routines + Previous: psb_init Initializes +   Contents

        -

        -psb_get_mpicomm -- Get the MPI communicator +

        +psb_info -- Return information about PSBLAS parallel + environment

        -call psb_get_mpicomm(icontxt, icomm)
        +call psb_info(icontxt, iam, np)
         

        -This subroutine returns the MPI communicator associated with a PSBLAS context +This subroutine returns information about the PSBLAS parallel environment, defining +a virtual parallel machine.

        Type:
        Asynchronous. @@ -88,19 +90,83 @@ Specified as: an integer variable.
        On Return
        -
        icomm
        -
        The MPI communicator associated with the PSBLAS virtual parallel machine. +
        iam
        +
        Identifier of current process in the PSBLAS virtual parallel machine. +
        +Scope: local. +
        +Type: required. +
        +Intent: out. +
        +Specified as: an integer value. +$-1 \le iam \le np-1$
        +
        np
        +
        Number of processes in the PSBLAS virtual parallel machine.
        Scope: global.
        Type: required.
        Intent: out. -
        +
        +Specified as: an integer variable.

        -


        +Notes + +
          +
        1. For processes in the virtual parallel machine the identifier + will satisfy +$0 \le iam \le np-1$; +
        2. +
        3. If the user has requested on psb_init a number of + processes less than the total available in the parallel execution + environment, the remaining processes will have on return $iam=-1$; + the only call involving icontxt that any such process may + execute is to psb_exit. +
        4. +
        + +

        +


        + + +next + +up + +previous + +contents +
        + Next: psb_exit Exit + Up: Parallel environment routines + Previous: psb_init Initializes +   Contents + diff --git a/docs/html/node76.html b/docs/html/node76.html index 35db4e871..ca8b3727a 100644 --- a/docs/html/node76.html +++ b/docs/html/node76.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_get_rank -- Get the MPI rank - +psb_exit -- Exit from PSBLAS parallel environment + @@ -20,54 +20,52 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_wtime Wall - Up: Parallel environment routines - Previous: psb_get_mpicomm Get -   Next: psb_get_mpicomm Get + Up: Parallel environment routines + Previous: psb_info Return +   Contents

        -

        -psb_get_rank -- Get the MPI rank +

        +psb_exit -- Exit from PSBLAS parallel environment

        -call psb_get_rank(rank, icontxt, id)
        +call psb_exit(icontxt)
        +call psb_exit(icontxt,close)
         

        -This subroutine returns the MPI rank of the PSBLAS process $id$ +This subroutine exits from the PSBLAS parallel virtual machine.

        Type:
        -
        Asynchronous. +
        Synchronous.
        On Entry
        @@ -84,45 +82,69 @@ Intent: in.
        Specified as: an integer variable.
        -
        id
        -
        Identifier of a process in the PSBLAS virtual parallel machine. +
        close
        +
        Whether to close all data structures related to the + virtual parallel machine, besides those associated with icontxt.
        -Scope: local. +Scope: global.
        -Type: required. +Type: optional.
        Intent: in.
        -Specified as: an integer value. -$0 \le id \le np-1$
        -
        - -

        -

        -
        On Return
        -
        +Specified as: a logical variable, default value: true.
        -
        rank
        -
        The MPI rank associated with the PSBLAS process $id$. -
        -Scope: local. -
        -Type: required. -
        -Intent: out. -

        -


        +Notes + +
          +
        1. This routine may be called even if a previous call to + psb_info has returned with $iam=-1$; indeed, it it is the only + routine that may be called with argument icontxt in this + situation. +
        2. +
        3. A call to this routine with close=.true. implies a call + to MPI_Finalize, after which no parallel routine may be called. +
        4. +
        5. If the user whishes to use multiple communication contexts in the + same program, or to enter and exit multiple times into the parallel + environment, this routine may be called to + selectively close the contexts with close=.false., while on + the last call it should be called with close=.true. to + shutdown in a clean way the entire parallel environment. +
        6. +
        + +

        +


        + + +next + +up + +previous + +contents +
        + Next: psb_get_mpicomm Get + Up: Parallel environment routines + Previous: psb_info Return +   Contents + diff --git a/docs/html/node77.html b/docs/html/node77.html index e84bdc2de..65f59e21e 100644 --- a/docs/html/node77.html +++ b/docs/html/node77.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_wtime -- Wall clock timing - +psb_get_mpicomm -- Get the MPI communicator + @@ -20,63 +20,85 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_barrier Sinchronization - Up: Parallel environment routines - Previous: psb_get_rank Get -   Next: psb_get_rank Get + Up: Parallel environment routines + Previous: psb_exit Exit +   Contents

        -

        -psb_wtime -- Wall clock timing +

        +psb_get_mpicomm -- Get the MPI communicator

        -time = psb_wtime()
        +call psb_get_mpicomm(icontxt, icomm)
         

        -This function returns a wall clock timer. The resolution of the timer -is dependent on the underlying parallel environment implementation. +This subroutine returns the MPI communicator associated with a PSBLAS context

        Type:
        Asynchronous.
        -
        On Exit
        +
        On Entry
        -
        Function value
        -
        the elapsed time in seconds. +
        icontxt
        +
        the communication context identifying the virtual + parallel machine.
        -Returned as: a real(psb_dpk_) variable. +Scope: global. +
        +Type: required. +
        +Intent: in. +
        +Specified as: an integer variable.
        +

        +

        +
        On Return
        +
        +
        +
        icomm
        +
        The MPI communicator associated with the PSBLAS virtual parallel machine. +
        +Scope: global. +
        +Type: required. +
        +Intent: out. +
        +
        +



        diff --git a/docs/html/node78.html b/docs/html/node78.html index 642971c43..d90565bf4 100644 --- a/docs/html/node78.html +++ b/docs/html/node78.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_barrier -- Sinchronization point parallel environment - +psb_get_rank -- Get the MPI rank + @@ -20,53 +20,54 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_abort Abort - Up: Parallel environment routines - Previous: psb_wtime Wall -   Next: psb_wtime Wall + Up: Parallel environment routines + Previous: psb_get_mpicomm Get +   Contents

        -

        -psb_barrier -- Sinchronization point parallel - environment +

        +psb_get_rank -- Get the MPI rank

        -call psb_barrier(icontxt)
        +call psb_get_rank(rank, icontxt, id)
         

        -This subroutine acts as an explicit synchronization point for the PSBLAS -parallel virtual machine. +This subroutine returns the MPI rank of the PSBLAS process $id$

        Type:
        -
        Synchronous. +
        Asynchronous.
        On Entry
        @@ -83,6 +84,41 @@ Intent: in.
        Specified as: an integer variable.
        +
        id
        +
        Identifier of a process in the PSBLAS virtual parallel machine. +
        +Scope: local. +
        +Type: required. +
        +Intent: in. +
        +Specified as: an integer value. +$0 \le id \le np-1$
        +
        + +

        +

        +
        On Return
        +
        +
        +
        rank
        +
        The MPI rank associated with the PSBLAS process $id$. +
        +Scope: local. +
        +Type: required. +
        +Intent: out. +

        diff --git a/docs/html/node79.html b/docs/html/node79.html index 2599ea595..d577720f1 100644 --- a/docs/html/node79.html +++ b/docs/html/node79.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_abort -- Abort a computation - +psb_wtime -- Wall clock timing + @@ -20,66 +20,60 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
        - Next: psb_bcast Broadcast - Up: Parallel environment routines - Previous: psb_barrier Sinchronization -   Next: psb_barrier Sinchronization + Up: Parallel environment routines + Previous: psb_get_rank Get +   Contents

        -

        -psb_abort -- Abort a computation +

        +psb_wtime -- Wall clock timing

        -call psb_abort(icontxt)
        +time = psb_wtime()
         

        -This subroutine aborts computation on the parallel virtual machine. +This function returns a wall clock timer. The resolution of the timer +is dependent on the underlying parallel environment implementation.

        Type:
        Asynchronous.
        -
        On Entry
        +
        On Exit
        -
        icontxt
        -
        the communication context identifying the virtual - parallel machine. +
        Function value
        +
        the elapsed time in seconds.
        -Scope: global. -
        -Type: required. -
        -Intent: in. -
        -Specified as: an integer variable. +Returned as: a real(psb_dpk_) variable.
        diff --git a/docs/html/node8.html b/docs/html/node8.html index e6f32346f..c3ff2fa14 100644 --- a/docs/html/node8.html +++ b/docs/html/node8.html @@ -18,7 +18,7 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + @@ -26,26 +26,26 @@ original version by: Nikos Drakos, CBLU, University of Leeds - next - up - previous - contents
        - Next: Next: Descriptor data structure - Up: Up: userhtml - Previous: Previous: Programming model -   Contents

        @@ -91,55 +91,60 @@ it is only used for the psb_sizeof utility. Subsections
          -
        • Descriptor data structure
          -
        • Sparse Matrix data structure
          -
        • Preconditioner data structure -
        • Data structure query routines - diff --git a/docs/html/node80.html b/docs/html/node80.html index 81f9553dd..1f08bafcf 100644 --- a/docs/html/node80.html +++ b/docs/html/node80.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_bcast -- Broadcast data - +psb_barrier -- Sinchronization point parallel environment + @@ -20,49 +20,50 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
          - Next: psb_sum Global - Up: Parallel environment routines - Previous: psb_abort Abort -   Next: psb_abort Abort + Up: Parallel environment routines + Previous: psb_wtime Wall +   Contents

          -

          -psb_bcast -- Broadcast data +

          +psb_barrier -- Sinchronization point parallel + environment

          -call psb_bcast(icontxt, dat, root)
          +call psb_barrier(icontxt)
           

          -This subroutine implements a broadcast operation based on the -underlying communication library. +This subroutine acts as an explicit synchronization point for the PSBLAS +parallel virtual machine.

          Type:
          Synchronous. @@ -82,81 +83,10 @@ Intent: in.
          Specified as: an integer variable.
          -
          dat
          -
          On the root process, the data to be broadcast. -
          -Scope: global. -
          -Type: required. -
          -Intent: inout. -
          -Specified as: an integer, real or complex variable, which may be a -scalar, or a rank 1 or 2 array, or a character or logical variable, -which may be a scalar or rank 1 array. Type, kind, rank and size must agree on all processes. -
          -
          root
          -
          Root process holding data to be broadcast. -
          -Scope: global. -
          -Type: optional. -
          -Intent: in. -
          -Specified as: an integer value -$0<= root <= np-1$, default 0

          -

          -
          On Return
          -
          -
          -
          dat
          -
          On processes other than root, the data to be broadcast. -
          -Scope: global. -
          -Type: required. -
          -Intent: inout. -
          -Specified as: an integer, real or complex variable, which may be a -scalar, or a rank 1 or 2 array, or a character or logical scalar. Type, kind, rank and size must agree on all processes. -
          -
          - -

          -


          - - -next - -up - -previous - -contents -
          - Next: psb_sum Global - Up: Parallel environment routines - Previous: psb_abort Abort -   Contents - +

          diff --git a/docs/html/node81.html b/docs/html/node81.html index 22eb5aa7e..d3e853838 100644 --- a/docs/html/node81.html +++ b/docs/html/node81.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_sum -- Global sum - +psb_abort -- Abort a computation + @@ -20,52 +20,51 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
          - Next: psb_max Global - Up: Parallel environment routines - Previous: psb_bcast Broadcast -   Next: psb_bcast Broadcast + Up: Parallel environment routines + Previous: psb_barrier Sinchronization +   Contents

          -

          -psb_sum -- Global sum +

          +psb_abort -- Abort a computation

          -call psb_sum(icontxt, dat, root)
          +call psb_abort(icontxt)
           

          -This subroutine implements a sum reduction operation based on the -underlying communication library. +This subroutine aborts computation on the parallel virtual machine.

          Type:
          -
          Synchronous. +
          Asynchronous.
          On Entry
          @@ -82,98 +81,10 @@ Intent: in.
          Specified as: an integer variable.
          -
          dat
          -
          The local contribution to the global sum. -
          -Scope: global. -
          -Type: required. -
          -Intent: inout. -
          -Specified as: an integer, real or complex variable, which may be a -scalar, or a rank 1 or 2 array. Type, kind, rank and size must agree on all processes. -
          -
          root
          -
          Process to hold the final sum, or $-1$ to make it available - on all processes. -
          -Scope: global. -
          -Type: optional. -
          -Intent: in. -
          -Specified as: an integer value -$-1<= root <= np-1$, default -1.

          -

          -
          On Return
          -
          -
          -
          dat
          -
          On destination process(es), the result of the sum operation. -
          -Scope: global. -
          -Type: required. -
          -Intent: inout. -
          -Specified as: an integer, real or complex variable, which may be a -scalar, or a rank 1 or 2 array. -
          -Type, kind, rank and size must agree on all processes. -
          -
          - -

          -Notes - -

            -
          1. The dat argument is both input and output, and its - value may be changed even on processes different from the final - result destination. -
          2. -
          3. The dat argument may also be a long integer scalar. -
          4. -
          - -

          -


          - - -next - -up - -previous - -contents -
          - Next: psb_max Global - Up: Parallel environment routines - Previous: psb_bcast Broadcast -   Contents - +

          diff --git a/docs/html/node82.html b/docs/html/node82.html index c6d0e3da9..f27df5a71 100644 --- a/docs/html/node82.html +++ b/docs/html/node82.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_max -- Global maximum - +psb_bcast -- Broadcast data + @@ -20,49 +20,49 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
          - Next: psb_min Global - Up: Parallel environment routines - Previous: psb_sum Global -   Next: psb_sum Global + Up: Parallel environment routines + Previous: psb_abort Abort +   Contents

          -

          -psb_max -- Global maximum +

          +psb_bcast -- Broadcast data

          -call psb_max(icontxt, dat, root)
          +call psb_bcast(icontxt, dat, root)
           

          -This subroutine implements a maximum valuereduction -operation based on the underlying communication library. +This subroutine implements a broadcast operation based on the +underlying communication library.

          Type:
          Synchronous. @@ -83,23 +83,20 @@ Intent: in. Specified as: an integer variable.
          dat
          -
          The local contribution to the global maximum. +
          On the root process, the data to be broadcast.
          -Scope: local. +Scope: global.
          Type: required.
          Intent: inout.
          -Specified as: an integer or real variable, which may be a -scalar, or a rank 1 or 2 array. Type, kind, rank and size must agree on all processes. +Specified as: an integer, real or complex variable, which may be a +scalar, or a rank 1 or 2 array, or a character or logical variable, +which may be a scalar or rank 1 array. Type, kind, rank and size must agree on all processes.
          root
          -
          Process to hold the final maximum, or $-1$ to make it available - on all processes. +
          Root process holding data to be broadcast.
          Scope: global.
          @@ -108,13 +105,12 @@ Type: optional. Intent: in.
          Specified as: an integer value $-1<= root <= np-1$, default -1. -
          + ALT="$0<= root <= np-1$">, default 0

          @@ -123,54 +119,42 @@ Specified as: an integer value - next - + up - previous - contents
          - Next: psb_min Global - Up: Parallel environment routines - Previous: psb_sum Global -   Next: psb_sum Global + Up: Parallel environment routines + Previous: psb_abort Abort +   Contents diff --git a/docs/html/node83.html b/docs/html/node83.html index 12a359497..d817218be 100644 --- a/docs/html/node83.html +++ b/docs/html/node83.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_min -- Global minimum - +psb_sum -- Global sum + @@ -20,49 +20,49 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
          - Next: psb_amx Global - Up: Parallel environment routines - Previous: psb_max Global -   Next: psb_max Global + Up: Parallel environment routines + Previous: psb_bcast Broadcast +   Contents

          -

          -psb_min -- Global minimum +

          +psb_sum -- Global sum

          -call psb_min(icontxt, dat, root)
          +call psb_sum(icontxt, dat, root)
           

          -This subroutine implements a minimum value reduction -operation based on the underlying communication library. +This subroutine implements a sum reduction operation based on the +underlying communication library.

          Type:
          Synchronous. @@ -83,21 +83,21 @@ Intent: in. Specified as: an integer variable.
          dat
          -
          The local contribution to the global minimum. +
          The local contribution to the global sum.
          -Scope: local. +Scope: global.
          Type: required.
          Intent: inout.
          -Specified as: an integer or real variable, which may be a +Specified as: an integer, real or complex variable, which may be a scalar, or a rank 1 or 2 array. Type, kind, rank and size must agree on all processes.
          root
          -
          Process to hold the final value, or Process to hold the final sum, or $-1$ to make it available on all processes.
          @@ -112,9 +112,8 @@ Specified as: an integer value $-1<= root <= np-1$, default -1. -
          + SRC="img130.png" + ALT="$-1<= root <= np-1$">, default -1.

          @@ -123,7 +122,7 @@ Specified as: an integer value - next - + up - previous - contents
          - Next: psb_amx Global - Up: Parallel environment routines - Previous: psb_max Global -   Next: psb_max Global + Up: Parallel environment routines + Previous: psb_bcast Broadcast +   Contents diff --git a/docs/html/node84.html b/docs/html/node84.html index 93fba0f50..0b27f94e5 100644 --- a/docs/html/node84.html +++ b/docs/html/node84.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_amx -- Global maximum absolute value - +psb_max -- Global maximum + @@ -20,48 +20,48 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
          - Next: psb_amn Global - Up: Parallel environment routines - Previous: psb_min Global -   Next: psb_min Global + Up: Parallel environment routines + Previous: psb_sum Global +   Contents

          -

          -psb_amx -- Global maximum absolute value +

          +psb_max -- Global maximum

          -call psb_amx(icontxt, dat, root)
          +call psb_max(icontxt, dat, root)
           

          -This subroutine implements a maximum absolute value reduction +This subroutine implements a maximum valuereduction operation based on the underlying communication library.

          Type:
          @@ -91,13 +91,13 @@ Type: required.
          Intent: inout.
          -Specified as: an integer, real or complex variable, which may be a +Specified as: an integer or real variable, which may be a scalar, or a rank 1 or 2 array. Type, kind, rank and size must agree on all processes.
          root
          -
          Process to hold the final value, or Process to hold the final maximum, or $-1$ to make it available on all processes.
          @@ -112,7 +112,7 @@ Specified as: an integer value $-1<= root <= np-1$, default -1.
          @@ -129,9 +129,9 @@ Scope: global.
          Type: required.
          -Intent: inout. +Intent: in.
          -Specified as: an integer, real or complex variable, which may be a +Specified as: an integer or real variable, which may be a scalar, or a rank 1 or 2 array. Type, kind, rank and size must agree on all processes. @@ -151,26 +151,26 @@ scalar, or a rank 1 or 2 array. Type, kind, rank and size must agree on all pro


          - next - + up - previous - contents
          - Next: psb_amn Global - Up: Parallel environment routines - Previous: psb_min Global -   Next: psb_min Global + Up: Parallel environment routines + Previous: psb_sum Global +   Contents diff --git a/docs/html/node85.html b/docs/html/node85.html index 0c48444f0..a7ab46686 100644 --- a/docs/html/node85.html +++ b/docs/html/node85.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_amn -- Global minimum absolute value - +psb_min -- Global minimum + @@ -20,48 +20,48 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
          - Next: psb_snd Send - Up: Parallel environment routines - Previous: psb_amx Global -   Next: psb_amx Global + Up: Parallel environment routines + Previous: psb_max Global +   Contents

          -

          -psb_amn -- Global minimum absolute value +

          +psb_min -- Global minimum

          -call psb_amn(icontxt, dat, root)
          +call psb_min(icontxt, dat, root)
           

          -This subroutine implements a minimum absolute value reduction +This subroutine implements a minimum value reduction operation based on the underlying communication library.

          Type:
          @@ -91,13 +91,13 @@ Type: required.
          Intent: inout.
          -Specified as: an integer, real or complex variable, which may be a +Specified as: an integer or real variable, which may be a scalar, or a rank 1 or 2 array. Type, kind, rank and size must agree on all processes.
          root
          Process to hold the final value, or $-1$ to make it available on all processes.
          @@ -112,7 +112,7 @@ Specified as: an integer value $-1<= root <= np-1$, default -1.
          @@ -131,7 +131,7 @@ Type: required.
          Intent: inout.
          -Specified as: an integer, real or complex variable, which may be a +Specified as: an integer or real variable, which may be a scalar, or a rank 1 or 2 array.
          Type, kind, rank and size must agree on all processes. @@ -153,26 +153,26 @@ Type, kind, rank and size must agree on all processes.


          - next - + up - previous - contents
          - Next: psb_snd Send - Up: Parallel environment routines - Previous: psb_amx Global -   Next: psb_amx Global + Up: Parallel environment routines + Previous: psb_max Global +   Contents diff --git a/docs/html/node86.html b/docs/html/node86.html index df6a9dff4..95c34f135 100644 --- a/docs/html/node86.html +++ b/docs/html/node86.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_snd -- Send data - +psb_amx -- Global maximum absolute value + @@ -20,51 +20,52 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
          - Next: psb_rcv Receive - Up: Parallel environment routines - Previous: psb_amn Global -   Next: psb_amn Global + Up: Parallel environment routines + Previous: psb_min Global +   Contents

          -

          -psb_snd -- Send data +

          +psb_amx -- Global maximum absolute value

          -call psb_snd(icontxt, dat, dst, m)
          +call psb_amx(icontxt, dat, root)
           

          -This subroutine sends a packet of data to a destination. +This subroutine implements a maximum absolute value reduction +operation based on the underlying communication library.

          Type:
          -
          Synchronous: see usage notes. +
          Synchronous.
          On Entry
          @@ -82,65 +83,38 @@ Intent: in. Specified as: an integer variable.
          dat
          -
          The data to be sent. +
          The local contribution to the global maximum.
          Scope: local.
          Type: required.
          -Intent: in. +Intent: inout.
          Specified as: an integer, real or complex variable, which may be a -scalar, or a rank 1 or 2 array, or a character or logical scalar. Type, kind and rank must agree on sender and receiver process; if +
          root
          +
          Process to hold the final value, or $-1$ to make it available + on all processes. +
          +Scope: global. +
          +Type: optional. +
          +Intent: in. +
          +Specified as: an integer value +$m$ is -not specified, size must agree as well. -
          -
          dst
          -
          Destination process. -
          -Scope: global. -
          -Type: required. -
          -Intent: in. -
          -Specified as: an integer value -$0<= dst <= np-1$. + ALT="$-1<= root <= np-1$">, default -1.
          -
          m
          -
          Number of rows. -
          -Scope: global. -
          -Type: Optional. -
          -Intent: in. -
          -Specified as: an integer value -$0<= m <= size(dat,1)$. -
          -When $dat$ is a rank 2 array, specifies the number of rows to be sent -independently of the leading dimension $size(dat,1)$; must have the -same value on sending and receiving processes. -

          @@ -148,43 +122,55 @@ same value on sending and receiving processes.

          On Return
          +
          dat
          +
          On destination process(es), the result of the maximum operation. +
          +Scope: global. +
          +Type: required. +
          +Intent: inout. +
          +Specified as: an integer, real or complex variable, which may be a +scalar, or a rank 1 or 2 array. Type, kind, rank and size must agree on all processes. +

          Notes

            -
          1. This subroutine implies a synchronization, but only between the - calling process and the destination process $dst$. +
          2. The dat argument is both input and output, and its + value may be changed even on processes different from the final + result destination. +
          3. +
          4. The dat argument may also be a long integer scalar.


          - next - + up - previous - contents
          - Next: psb_rcv Receive - Up: Parallel environment routines - Previous: psb_amn Global -   Next: psb_amn Global + Up: Parallel environment routines + Previous: psb_min Global +   Contents diff --git a/docs/html/node87.html b/docs/html/node87.html index 8e302fc35..776b3c958 100644 --- a/docs/html/node87.html +++ b/docs/html/node87.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_rcv -- Receive data - +psb_amn -- Global minimum absolute value + @@ -18,52 +18,54 @@ original version by: Nikos Drakos, CBLU, University of Leeds + - + - next - + up - previous - contents
          - Next: Error handling - Up: Parallel environment routines - Previous: psb_snd Send -   Next: psb_snd Send + Up: Parallel environment routines + Previous: psb_amx Global +   Contents

          -

          -psb_rcv -- Receive data +

          +psb_amn -- Global minimum absolute value

          -call psb_rcv(icontxt, dat, src, m)
          +call psb_amn(icontxt, dat, root)
           

          -This subroutine receives a packet of data to a destination. +This subroutine implements a minimum absolute value reduction +operation based on the underlying communication library.

          Type:
          -
          Synchronous: see usage notes. +
          Synchronous.
          On Entry
          @@ -80,59 +82,8 @@ Intent: in.
          Specified as: an integer variable.
          -
          src
          -
          Source process. -
          -Scope: global. -
          -Type: required. -
          -Intent: in. -
          -Specified as: an integer value -$0<= src <= np-1$. -
          -
          m
          -
          Number of rows. -
          -Scope: global. -
          -Type: Optional. -
          -Intent: in. -
          -Specified as: an integer value -$0<= m <= size(dat,1)$. -
          -When $dat$ is a rank 2 array, specifies the number of rows to be sent -independently of the leading dimension $size(dat,1)$; must have the -same value on sending and receiving processes. -
          -
          - -

          -

          -
          On Return
          -
          -
          dat
          -
          The data to be received. +
          The local contribution to the global minimum.
          Scope: local.
          @@ -141,11 +92,49 @@ Type: required. Intent: inout.
          Specified as: an integer, real or complex variable, which may be a -scalar, or a rank 1 or 2 array, or a character or logical scalar. Type, kind and rank must agree on sender and receiver process; if +
          root
          +
          Process to hold the final value, or $-1$ to make it available + on all processes. +
          +Scope: global. +
          +Type: optional. +
          +Intent: in. +
          +Specified as: an integer value +$m$ is -not specified, size must agree as well. + ALT="$-1<= root <= np-1$">, default -1. +
          +
          + +

          +

          +
          On Return
          +
          +
          +
          dat
          +
          On destination process(es), the result of the minimum operation. +
          +Scope: global. +
          +Type: required. +
          +Intent: inout. +
          +Specified as: an integer, real or complex variable, which may be a +scalar, or a rank 1 or 2 array. +
          +Type, kind, rank and size must agree on all processes.
          @@ -153,37 +142,37 @@ not specified, size must agree as well. Notes
            -
          1. This subroutine implies a synchronization, but only between the - calling process and the source process $src$. +
          2. The dat argument is both input and output, and its + value may be changed even on processes different from the final + result destination. +
          3. +
          4. The dat argument may also be a long integer scalar.


          - next - + up - previous - contents
          - Next: Error handling - Up: Parallel environment routines - Previous: psb_snd Send -   Next: psb_snd Send + Up: Parallel environment routines + Previous: psb_amx Global +   Contents diff --git a/docs/html/node88.html b/docs/html/node88.html index d25b16c85..824aeb554 100644 --- a/docs/html/node88.html +++ b/docs/html/node88.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -Error handling - +psb_snd -- Send data + @@ -18,174 +18,173 @@ original version by: Nikos Drakos, CBLU, University of Leeds - - - + + + - next - + up - previous - contents
          - Next: psb_errpush Pushes - Up: userhtml - Previous: psb_rcv Receive -   Next: psb_rcv Receive + Up: Parallel environment routines + Previous: psb_amn Global +   Contents

          -

          -Error handling -

          +

          +psb_snd -- Send data +

          -The PSBLAS library error handling policy has been completely rewritten -in version 2.0. The idea behind the design of this new error handling -strategy is to keep error messages on a stack allowing the user to -trace back up to the point where the first error message has been -generated. Every routine in the PSBLAS-2.0 library has, as last -non-optional argument, an integer info variable; whenever, -inside the routine, an error is detected, this variable is set to a -value corresponding to a specific error code. Then this error code is -also pushed on the error stack and then either control is returned to -the caller routine or the execution is aborted, depending on the users -choice. At the time when the execution is aborted, an error message is -printed on standard output with a level of verbosity than can be -chosen by the user. If the execution is not aborted, then, the caller -routine checks the value returned in the info variable and, if -not zero, an error condition is raised. This process continues on all the -levels of nested calls until the level where the user decides to abort -the program execution. +

          +call psb_snd(icontxt, dat, dst, m)
          +

          -Figure 8 shows the layout of a generic psb_foo -routine with respect to the PSBLAS-2.0 error handling policy. It is -possible to see how, whenever an error condition is detected, the -info variable is set to the corresponding error code which is, -then, pushed on top of the stack by means of the -psb_errpush. An error condition may be directly detected inside -a routine or indirectly checking the error code returned returned by a -called routine. Whenever an error is encountered, after it has been -pushed on stack, the program execution skips to a point where the -error condition is handled; the error condition is handled either by -returning control to the caller routine or by calling the -psb\_error routine which prints the content of the error stack -and aborts the program execution, according to the choice made by the -user with psb_set_erraction. The default is to print the error -and terminate the program, but the user may choose to handle the error -explicitly. - -

          - -

          - - - -
          Figure 8: -The layout of a generic psb_foo - routine with respect to PSBLAS-2.0 error handling policy.
          +This subroutine sends a packet of data to a destination. +
          +
          Type:
          +
          Synchronous: see usage notes. +
          +
          On Entry
          +
          +
          +
          icontxt
          +
          the communication context identifying the virtual + parallel machine.
          - -
          - \fbox{\TheSbox} -
          -
          - -

          -Figure 9 reports a sample error message generated by -the PSBLAS-2.0 library. This error has been generated by the fact that -the user has chosen the invalid ``FOO'' storage format to represent -the sparse matrix. From this error message it is possible to see that -the error has been detected inside the psb_cest subroutine -called by psb_spasb ... by process 0 (i.e. the root process). - -

          - -

          - - - -
          Figure 9: -A sample PSBLAS-2.0 error - message. Process 0 detected an error condition inside the psb_cest subroutine
          + WIDTH="145" HEIGHT="30" ALIGN="MIDDLE" BORDER="0" + SRC="img132.png" + ALT="$0<= dst <= np-1$">. +
          +
          m
          +
          Number of rows.
          - -
          - \fbox{\TheSbox} -
          -
          + WIDTH="172" HEIGHT="32" ALIGN="MIDDLE" BORDER="0" + SRC="img133.png" + ALT="$0<= m <= size(dat,1)$">. +
          +When $dat$ is a rank 2 array, specifies the number of rows to be sent +independently of the leading dimension $size(dat,1)$; must have the +same value on sending and receiving processes. + +

          -


          - -Subsections +
          +
          On Return
          +
          +
          +
          - - +

          +Notes + +

            +
          1. This subroutine implies a synchronization, but only between the + calling process and the destination process $dst$. +
          2. +
          + +


          - next - + up - previous - contents
          - Next: psb_errpush Pushes - Up: userhtml - Previous: psb_rcv Receive -   Next: psb_rcv Receive + Up: Parallel environment routines + Previous: psb_amn Global +   Contents diff --git a/docs/html/node89.html b/docs/html/node89.html index 29500ffd5..117fc806c 100644 --- a/docs/html/node89.html +++ b/docs/html/node89.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_errpush -- Pushes an error code onto the error stack - +psb_rcv -- Receive data + @@ -18,101 +18,174 @@ original version by: Nikos Drakos, CBLU, University of Leeds - - + - next - + up - previous - contents
          - Next: psb_error Prints - Up: Error handling - Previous: Error handling -   Next: Error handling + Up: Parallel environment routines + Previous: psb_snd Send +   Contents

          -

          -psb_errpush -- Pushes an error code onto the error - stack +

          +psb_rcv -- Receive data

          -call psb_errpush(err_c, r_name, i_err, a_err)
          +call psb_rcv(icontxt, dat, src, m)
           

          +This subroutine receives a packet of data to a destination.

          Type:
          -
          Asynchronous. +
          Synchronous: see usage notes.
          -
          On Entry
          +
          On Entry
          -
          err_c
          -
          the error code +
          icontxt
          +
          the communication context identifying the virtual + parallel machine.
          -Scope: local +Scope: global.
          -Type: required +Type: required.
          Intent: in.
          -Specified as: an integer. +Specified as: an integer variable.
          -
          r_name
          -
          the soutine where the error has been caught. +
          src
          +
          Source process.
          -Scope: local +Scope: global.
          -Type: required +Type: required.
          Intent: in.
          -Specified as: a string. +Specified as: an integer value +$0<= src <= np-1$.
          -
          i_err
          -
          addional info for error code +
          m
          +
          Number of rows.
          -Scope: local +Scope: global.
          -Type: optional +Type: Optional.
          -Specified as: an integer array -
          -
          a_err
          -
          addional info for error code +Intent: in.
          -Scope: local +Specified as: an integer value +$0<= m <= size(dat,1)$.
          -Type: optional -
          -Specified as: a string. -
          +When $dat$ is a rank 2 array, specifies the number of rows to be sent +independently of the leading dimension $size(dat,1)$; must have the +same value on sending and receiving processes. +

          -


          +
          +
          On Return
          +
          +
          +
          dat
          +
          The data to be received. +
          +Scope: local. +
          +Type: required. +
          +Intent: inout. +
          +Specified as: an integer, real or complex variable, which may be a +scalar, or a rank 1 or 2 array, or a character or logical scalar. Type, kind and rank must agree on sender and receiver process; if $m$ is +not specified, size must agree as well. +
          +
          + +

          +Notes + +

            +
          1. This subroutine implies a synchronization, but only between the + calling process and the source process $src$. +
          2. +
          + +

          +


          + + +next + +up + +previous + +contents +
          + Next: Error handling + Up: Parallel environment routines + Previous: psb_snd Send +   Contents + diff --git a/docs/html/node9.html b/docs/html/node9.html index e9e48c3de..202c7ed33 100644 --- a/docs/html/node9.html +++ b/docs/html/node9.html @@ -26,26 +26,26 @@ original version by: Nikos Drakos, CBLU, University of Leeds - next - up - previous - contents
          - Next: Next: Named Constants - Up: Up: Data Structures - Previous: Previous: Data Structures -   Contents

          @@ -66,8 +66,8 @@ exchanged among processes.

          It is not necessary for the user to know the internal structure of psb_desc_type, it is set in a transparent mode by the tools -routines of Sec. 6, and its fields may be accessed -if necessary via the routines of sec. 3.4; +routines of Sec. 6, and its fields may be accessed +if necessary via the routines of sec. 3.5; nevertheless we include a description for the curious reader:

          @@ -166,7 +166,7 @@ Specified as: an allocatable integer array of rank one. The Fortran 95 definition for psb_desc_type structures is as follows: -
          +
          Figure 3: The PSBLAS defined data type that @@ -179,7 +179,7 @@ The PSBLAS defined data type that $\fbox{\TheSbox}$ --> \fbox{\TheSbox} @@ -208,7 +208,7 @@ the index space; the second is more complex, but only requires memory proportional to the local index space size. The choice is made at the time of the initialization according to a threshold; this threshold may be queried and set using the functions in -sec. 3.4. +sec. 3.5.



          @@ -216,32 +216,32 @@ sec. 3.4. Subsections
          - next - up - previous - contents
          - Next: Next: Named Constants - Up: Up: Data Structures - Previous: Previous: Data Structures -   Contents diff --git a/docs/html/node90.html b/docs/html/node90.html index 6ebbc76f7..924d19384 100644 --- a/docs/html/node90.html +++ b/docs/html/node90.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_error -- Prints the error stack content and aborts execution - +Error handling + @@ -18,72 +18,176 @@ original version by: Nikos Drakos, CBLU, University of Leeds - - - + + + - next - + up - previous - contents
          - Next: psb_set_errverbosity Sets - Up: Error handling - Previous: psb_errpush Pushes -   Next: psb_errpush Pushes + Up: userhtml + Previous: psb_rcv Receive +   Contents

          -

          -psb_error -- Prints the error stack content and aborts - execution -

          +

          +Error handling +

          -

          -call psb_error(icontxt)
          -
          +The PSBLAS library error handling policy has been completely rewritten +in version 2.0. The idea behind the design of this new error handling +strategy is to keep error messages on a stack allowing the user to +trace back up to the point where the first error message has been +generated. Every routine in the PSBLAS-2.0 library has, as last +non-optional argument, an integer info variable; whenever, +inside the routine, an error is detected, this variable is set to a +value corresponding to a specific error code. Then this error code is +also pushed on the error stack and then either control is returned to +the caller routine or the execution is aborted, depending on the users +choice. At the time when the execution is aborted, an error message is +printed on standard output with a level of verbosity than can be +chosen by the user. If the execution is not aborted, then, the caller +routine checks the value returned in the info variable and, if +not zero, an error condition is raised. This process continues on all the +levels of nested calls until the level where the user decides to abort +the program execution.

          -

          -
          Type:
          -
          Asynchronous. -
          -
          On Entry
          -
          -
          -
          icontxt
          -
          the communication context. +Figure 9 shows the layout of a generic psb_foo +routine with respect to the PSBLAS-2.0 error handling policy. It is +possible to see how, whenever an error condition is detected, the +info variable is set to the corresponding error code which is, +then, pushed on top of the stack by means of the +psb_errpush. An error condition may be directly detected inside +a routine or indirectly checking the error code returned returned by a +called routine. Whenever an error is encountered, after it has been +pushed on stack, the program execution skips to a point where the +error condition is handled; the error condition is handled either by +returning control to the caller routine or by calling the +psb\_error routine which prints the content of the error stack +and aborts the program execution, according to the choice made by the +user with psb_set_erraction. The default is to print the error +and terminate the program, but the user may choose to handle the error +explicitly. + +

          + +

          + + + +
          Figure 9: +The layout of a generic psb_foo + routine with respect to PSBLAS-2.0 error handling policy.

          -Scope: global + +
          + +\fbox{\TheSbox} +
          +
          + +

          +Figure 10 reports a sample error message generated by +the PSBLAS-2.0 library. This error has been generated by the fact that +the user has chosen the invalid ``FOO'' storage format to represent +the sparse matrix. From this error message it is possible to see that +the error has been detected inside the psb_cest subroutine +called by psb_spasb ... by process 0 (i.e. the root process). + +

          + +

          + + + +
          Figure 10: +A sample PSBLAS-2.0 error + message. Process 0 detected an error condition inside the psb_cest subroutine

          -Type: optional -
          -Intent: in. -
          -Specified as: an integer. - - + +
          + +\fbox{\TheSbox} +
          +



          + +Subsections + + + +
          + + +next + +up + +previous + +contents +
          + Next: psb_errpush Pushes + Up: userhtml + Previous: psb_rcv Receive +   Contents + diff --git a/docs/html/node91.html b/docs/html/node91.html index 6f2325aeb..6b1ccd278 100644 --- a/docs/html/node91.html +++ b/docs/html/node91.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_set_errverbosity -- Sets the verbosity of error messages. - +psb_errpush -- Pushes an error code onto the error stack + @@ -20,45 +20,45 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
          - Next: psb_set_erraction Set - Up: Error handling - Previous: psb_error Prints -   Next: psb_error Prints + Up: Error handling + Previous: Error handling +   Contents

          -

          -psb_set_errverbosity -- Sets the verbosity of error - messages. +

          +psb_errpush -- Pushes an error code onto the error + stack

          -call psb_set_errverbosity(v)
          +call psb_errpush(err_c, r_name, i_err, a_err)
           

          @@ -69,10 +69,10 @@ call psb_set_errverbosity(v)

          On Entry
          -
          v
          -
          the verbosity level +
          err_c
          +
          the error code
          -Scope: global +Scope: local
          Type: required
          @@ -80,6 +80,35 @@ Intent: in.
          Specified as: an integer.
          +
          r_name
          +
          the soutine where the error has been caught. +
          +Scope: local +
          +Type: required +
          +Intent: in. +
          +Specified as: a string. +
          +
          i_err
          +
          addional info for error code +
          +Scope: local +
          +Type: optional +
          +Specified as: an integer array +
          +
          a_err
          +
          addional info for error code +
          +Scope: local +
          +Type: optional +
          +Specified as: a string. +

          diff --git a/docs/html/node92.html b/docs/html/node92.html index 3c322dc4d..4b91bd994 100644 --- a/docs/html/node92.html +++ b/docs/html/node92.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -psb_set_erraction -- Set the type of action to be taken upon error condition. - +psb_error -- Prints the error stack content and aborts execution + @@ -18,46 +18,47 @@ original version by: Nikos Drakos, CBLU, University of Leeds + - + - next - + up - previous - contents
          - Next: Utilities - Up: Error handling - Previous: psb_set_errverbosity Sets -   Next: psb_set_errverbosity Sets + Up: Error handling + Previous: psb_errpush Pushes +   Contents

          -

          -psb_set_erraction -- Set the type of action to be - taken upon error condition. +

          +psb_error -- Prints the error stack content and aborts + execution

          -call psb_set_erraction(err_act)
          +call psb_error(icontxt)
           

          @@ -68,25 +69,19 @@ call psb_set_erraction(err_act)

          On Entry
          -
          err_act
          -
          the type of action. +
          icontxt
          +
          the communication context.
          Scope: global
          -Type: required +Type: optional
          Intent: in.
          -Specified as: an integer. Possible values: psb_act_ret, -psb_act_abort. +Specified as: an integer.
          -

          -

          -call psb_errcomm(icontxt, err)
          -
          -



          diff --git a/docs/html/node93.html b/docs/html/node93.html index 7dca15081..bcdc4d0f2 100644 --- a/docs/html/node93.html +++ b/docs/html/node93.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -Utilities - +psb_set_errverbosity -- Sets the verbosity of error messages. + @@ -18,73 +18,71 @@ original version by: Nikos Drakos, CBLU, University of Leeds - - - + + + - next - + up - previous - contents
          - Next: hb_read Read - Up: userhtml - Previous: psb_set_erraction Set -   Next: psb_set_erraction Set + Up: Error handling + Previous: psb_error Prints +   Contents

          -

          - +

          +psb_set_errverbosity -- Sets the verbosity of error + messages. +

          + +

          +

          +call psb_set_errverbosity(v)
          +
          + +

          +

          +
          Type:
          +
          Asynchronous. +
          +
          On Entry
          +
          +
          +
          v
          +
          the verbosity level
          -Utilities - +Scope: global +
          +Type: required +
          +Intent: in. +
          +Specified as: an integer. +
          +

          -We have some utitlities available for input and output of -sparsematrices; the interfaces to these routines are available in the -module psb_util_mod. - -

          -


          - -Subsections - - -

          diff --git a/docs/html/node94.html b/docs/html/node94.html index a2b113efd..10d98ab10 100644 --- a/docs/html/node94.html +++ b/docs/html/node94.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -hb_read -- Read a sparse matrix from a file in the Harwell-Boeing format - +psb_set_erraction -- Set the type of action to be taken upon error condition. + @@ -18,9 +18,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds - - + @@ -30,9 +29,9 @@ original version by: Nikos Drakos, CBLU, University of Leeds HREF="node95.html"> next + HREF="node90.html"> up - previous
          Next: hb_write Write + HREF="node95.html">Utilities Up: Utilities - Previous: Utilities + HREF="node90.html">Error handling + Previous: psb_set_errverbosity Sets   Contents

          -

          -hb_read -- Read a sparse matrix from a file in the - Harwell-Boeing format +

          +psb_set_erraction -- Set the type of action to be + taken upon error condition.

          -call hb_read(a, iret, iunit, filename, b, mtitle)
          +call psb_set_erraction(err_act)
           

          @@ -66,91 +65,30 @@ call hb_read(a, iret, iunit, filename, b, mtitle)

          Type:
          Asynchronous.
          -
          On Entry
          +
          On Entry
          -
          filename
          -
          The name of the file to be read. +
          err_act
          +
          the type of action.
          -Type:optional. +Scope: global
          -Specified as: a character variable containing a valid file name, or --, in which case the default input unit 5 (i.e. standard input -in Unix jargon) is used. Default: -. -
          -
          iunit
          -
          The Fortran file unit number. +Type: required
          -Type:optional. +Intent: in.
          -Specified as: an integer value. Only meaningful if filename is not -. +Specified as: an integer. Possible values: psb_act_ret, +psb_act_abort.

          -

          -
          On Return
          -
          -
          -
          a
          -
          the sparse matrix read from file. -
          -Type:required. -
          -Specified as: a structured data of type spdatapsb_spmat_type. -
          -
          b
          -
          Rigth hand side(s). -
          -Type: Optional -
          -An array of type real or complex, rank 2 and having the ALLOCATABLE -attribute; will be allocated and filled in if the input file contains -a right hand side, otherwise will be left in the UNALLOCATED state. -
          -
          mtitle
          -
          Matrix title. -
          -Type: Optional -
          -A charachter variable of length 72 holding a copy of the -matrix title as specified by the Harwell-Boeing format and contained -in the input file. -
          -
          iret
          -
          Error code. -
          -Type: required -
          -An integer value; 0 means no error has been detected. -
          -
          +
          +call psb_errcomm(icontxt, err)
          +

          -


          - - -next - -up - -previous - -contents -
          - Next: hb_write Write - Up: Utilities - Previous: Utilities -   Contents - +

          diff --git a/docs/html/node95.html b/docs/html/node95.html index 982c62e17..a948e5344 100644 --- a/docs/html/node95.html +++ b/docs/html/node95.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -hb_write -- Write a sparse matrix to a file in the Harwell-Boeing format - +Utilities + @@ -18,9 +18,9 @@ original version by: Nikos Drakos, CBLU, University of Leeds - - - + + + @@ -30,7 +30,7 @@ original version by: Nikos Drakos, CBLU, University of Leeds HREF="node96.html"> next + HREF="userhtml.html"> up @@ -40,126 +40,52 @@ original version by: Nikos Drakos, CBLU, University of Leeds contents
          Next: mm_mat_read Read + HREF="node96.html">hb_read Read Up: Utilities + HREF="userhtml.html">userhtml Previous: hb_read Read + HREF="node94.html">psb_set_erraction Set   Contents

          -

          -hb_write -- Write a sparse matrix to a file +

          + +
          +Utilities +

          + +

          +We have some utitlities available for input and output of +sparsematrices; the interfaces to these routines are available in the +module psb_util_mod. + +

          +


          + +Subsections + +

          - -

          -

          -call hb_write(a, iret, iunit, filename, key, rhs, mtitle)
          -
          - -

          -

          -
          Type:
          -
          Asynchronous. -
          -
          On Entry
          -
          -
          -
          a
          -
          the sparse matrix to be written. -
          -Type:required. -
          -Specified as: a structured data of type spdatapsb_spmat_type. -
          -
          b
          -
          Rigth hand side. -
          -Type: Optional -
          -An array of type real or complex, rank 1 and having the ALLOCATABLE -attribute; will be allocated and filled in if the input file contains -a right hand side. -
          -
          filename
          -
          The name of the file to be written to. -
          -Type:optional. -
          -Specified as: a character variable containing a valid file name, or --, in which case the default output unit 6 (i.e. standard output -in Unix jargon) is used. Default: -. -
          -
          iunit
          -
          The Fortran file unit number. -
          -Type:optional. -
          -Specified as: an integer value. Only meaningful if filename is not -. -
          -
          key
          -
          Matrix key. -
          -Type: Optional -
          -A charachter variable of length 8 holding the -matrix key as specified by the Harwell-Boeing format and to be -written to file. -
          -
          mtitle
          -
          Matrix title. -
          -Type: Optional -
          -A charachter variable of length 72 holding the -matrix title as specified by the Harwell-Boeing format and to be -written to file. -
          -
          - -

          -

          -
          On Return
          -
          -
          -
          iret
          -
          Error code. -
          -Type: required -
          -An integer value; 0 means no error has been detected. -
          -
          - -

          -


          - - -next - -up - -previous - -contents -
          - Next: mm_mat_read Read - Up: Utilities - Previous: hb_read Read -   Contents - +
        • mm_mat_read -- Read a sparse matrix from a + file in the MatrixMarket format +
        • mm_vet_read -- Read a dense vector from a + file in the MatrixMarket format +
        • mm_mat_write -- Write a sparse matrix to a + file in the MatrixMarket format + + +

          diff --git a/docs/html/node96.html b/docs/html/node96.html index 6f5ee358e..badca7bd6 100644 --- a/docs/html/node96.html +++ b/docs/html/node96.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -mm_mat_read -- Read a sparse matrix from a file in the MatrixMarket format - +hb_read -- Read a sparse matrix from a file in the Harwell-Boeing format + @@ -20,45 +20,45 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
          - Next: mm_vet_read Read - Up: Utilities - Previous: hb_write Write -   Next: hb_write Write + Up: Utilities + Previous: Utilities +   Contents

          -

          -mm_mat_read -- Read a sparse matrix from a - file in the MatrixMarket format +

          +hb_read -- Read a sparse matrix from a file in the + Harwell-Boeing format

          -call mm_mat_read(a, iret, iunit, filename)
          +call hb_read(a, iret, iunit, filename, b, mtitle)
           

          @@ -99,6 +99,24 @@ Type:required.
          Specified as: a structured data of type spdatapsb_spmat_type. +

          b
          +
          Rigth hand side(s). +
          +Type: Optional +
          +An array of type real or complex, rank 2 and having the ALLOCATABLE +attribute; will be allocated and filled in if the input file contains +a right hand side, otherwise will be left in the UNALLOCATED state. +
          +
          mtitle
          +
          Matrix title. +
          +Type: Optional +
          +A charachter variable of length 72 holding a copy of the +matrix title as specified by the Harwell-Boeing format and contained +in the input file. +
          iret
          Error code.
          @@ -109,7 +127,30 @@ An integer value; 0 means no error has been detected.

          -


          +
          + + +next + +up + +previous + +contents +
          + Next: hb_write Write + Up: Utilities + Previous: Utilities +   Contents + diff --git a/docs/html/node97.html b/docs/html/node97.html index 1e61fc49f..16fe819da 100644 --- a/docs/html/node97.html +++ b/docs/html/node97.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -mm_vet_read -- Read a dense vector from a file in the MatrixMarket format - +hb_write -- Write a sparse matrix to a file in the Harwell-Boeing format + @@ -20,44 +20,45 @@ original version by: Nikos Drakos, CBLU, University of Leeds - + - next - + up - previous - contents
          - Next: mm_mat_write Write - Up: Utilities - Previous: mm_mat_read Read -   Next: mm_mat_read Read + Up: Utilities + Previous: hb_read Read +   Contents

          -

          -mm_vet_read -- Read a dense vector from a - file in the MatrixMarket format +

          +hb_write -- Write a sparse matrix to a file + in the Harwell-Boeing format

          +

          -call mm_vet_read(b, iret, iunit, filename)
          +call hb_write(a, iret, iunit, filename, key, rhs, mtitle)
           

          @@ -68,13 +69,29 @@ call mm_vet_read(b, iret, iunit, filename)

          On Entry
          +
          a
          +
          the sparse matrix to be written. +
          +Type:required. +
          +Specified as: a structured data of type spdatapsb_spmat_type. +
          +
          b
          +
          Rigth hand side. +
          +Type: Optional +
          +An array of type real or complex, rank 1 and having the ALLOCATABLE +attribute; will be allocated and filled in if the input file contains +a right hand side. +
          filename
          -
          The name of the file to be read. +
          The name of the file to be written to.
          Type:optional.
          Specified as: a character variable containing a valid file name, or --, in which case the default input unit 5 (i.e. standard input +-, in which case the default output unit 6 (i.e. standard output in Unix jargon) is used. Default: -.
          iunit
          @@ -84,6 +101,24 @@ Type:optional.
          Specified as: an integer value. Only meaningful if filename is not -. +
          key
          +
          Matrix key. +
          +Type: Optional +
          +A charachter variable of length 8 holding the +matrix key as specified by the Harwell-Boeing format and to be +written to file. +
          +
          mtitle
          +
          Matrix title. +
          +Type: Optional +
          +A charachter variable of length 72 holding the +matrix title as specified by the Harwell-Boeing format and to be +written to file. +

          @@ -91,15 +126,6 @@ Specified as: an integer value. Only meaningful if filename is not -On Return

          -
          b
          -
          Rigth hand side(s). -
          -Type: required -
          -An array of type real or complex, rank 2 and having the ALLOCATABLE -attribute; will be allocated and filled in if the input file contains -a right hand side, otherwise will be left in the UNALLOCATED state. -
          iret
          Error code.
          @@ -110,7 +136,30 @@ An integer value; 0 means no error has been detected.

          -


          +
          + + +next + +up + +previous + +contents +
          + Next: mm_mat_read Read + Up: Utilities + Previous: hb_read Read +   Contents + diff --git a/docs/html/node98.html b/docs/html/node98.html index 49f6b9c87..e8def9024 100644 --- a/docs/html/node98.html +++ b/docs/html/node98.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -mm_mat_write -- Write a sparse matrix to a file in the MatrixMarket format - +mm_mat_read -- Read a sparse matrix from a file in the MatrixMarket format + @@ -18,46 +18,50 @@ original version by: Nikos Drakos, CBLU, University of Leeds + - + - next - + up - previous - contents
          - Next: Preconditioner routines - Up: Utilities - Previous: mm_vet_read Read -   Next: mm_vet_read Read + Up: Utilities + Previous: hb_write Write +   Contents

          -

          -mm_mat_write -- Write a sparse matrix to a +

          +mm_mat_read -- Read a sparse matrix from a file in the MatrixMarket format

          +

          -call mm_mat_write(a, mtitle, iret, iunit, filename)
          +call mm_mat_read(a, iret, iunit, filename)
           
          + +

          Type:
          Asynchronous. @@ -65,28 +69,13 @@ call mm_mat_write(a, mtitle, iret, iunit, filename)
          On Entry
          -
          a
          -
          the sparse matrix to be written. -
          -Type:required. -
          -Specified as: a structured data of type spdatapsb_spmat_type. -
          -
          mtitle
          -
          Matrix title. -
          -Type: required -
          -A charachter variable holding a descriptive title for the matrix to be - written to file. -
          filename
          -
          The name of the file to be written to. +
          The name of the file to be read.
          Type:optional.
          Specified as: a character variable containing a valid file name, or --, in which case the default output unit 6 (i.e. standard output +-, in which case the default input unit 5 (i.e. standard input in Unix jargon) is used. Default: -.
          iunit
          @@ -103,6 +92,13 @@ Specified as: an integer value. Only meaningful if filename is not -On Return
          +
          a
          +
          the sparse matrix read from file. +
          +Type:required. +
          +Specified as: a structured data of type spdatapsb_spmat_type. +
          iret
          Error code.
          diff --git a/docs/html/node99.html b/docs/html/node99.html index 7ab60bd12..e4c7d6726 100644 --- a/docs/html/node99.html +++ b/docs/html/node99.html @@ -7,8 +7,8 @@ original version by: Nikos Drakos, CBLU, University of Leeds Jens Lippmann, Marek Rouchal, Martin Wilck and others --> -Preconditioner routines - +mm_vet_read -- Read a dense vector from a file in the MatrixMarket format + @@ -18,76 +18,99 @@ original version by: Nikos Drakos, CBLU, University of Leeds - - - + + + - next - + up - previous - contents
          - Next: psb_precinit Initialize - Up: userhtml - Previous: mm_mat_write Write -   Next: mm_mat_write Write + Up: Utilities + Previous: mm_mat_read Read +   Contents

          -

          - +

          +mm_vet_read -- Read a dense vector from a + file in the MatrixMarket format +

          + +
          +call mm_vet_read(b, iret, iunit, filename)
          +
          + +

          +

          +
          Type:
          +
          Asynchronous. +
          +
          On Entry
          +
          +
          +
          filename
          +
          The name of the file to be read.
          -Preconditioner routines -

          +Type:optional. +
          +Specified as: a character variable containing a valid file name, or +-, in which case the default input unit 5 (i.e. standard input +in Unix jargon) is used. Default: -. +
          +
          iunit
          +
          The Fortran file unit number. +
          +Type:optional. +
          +Specified as: an integer value. Only meaningful if filename is not -. +
          +

          -The base PSBLAS library contains the implementation of two simple -preconditioning techniques: - -

            -
          • Diagonal Scaling -
          • -
          • Block Jacobi with ILU(0) factorization -
          • -
          -The supporting data type and subroutine interfaces are defined in the -module psb_prec_mod. +
          +
          On Return
          +
          +
          +
          b
          +
          Rigth hand side(s). +
          +Type: required +
          +An array of type real or complex, rank 2 and having the ALLOCATABLE +attribute; will be allocated and filled in if the input file contains +a right hand side, otherwise will be left in the UNALLOCATED state. +
          +
          iret
          +
          Error code. +
          +Type: required +
          +An integer value; 0 means no error has been detected. +
          +



          - -Subsections - - - -

          diff --git a/docs/html/userhtml.html b/docs/html/userhtml.html index f2f604f84..21e6f6b15 100644 --- a/docs/html/userhtml.html +++ b/docs/html/userhtml.html @@ -23,18 +23,18 @@ original version by: Nikos Drakos, CBLU, University of Leeds - next up previous - contents
          - Next: Next: Contents -   Contents

          @@ -65,285 +65,289 @@ May 15th, 2010
            -
          • Contents
          • Introduction + HREF="node1.html">Contents
          • Introduction +
          • General overview
            -
          • Data Structures
            -
          • Computational routines -
              -
            • psb_geaxpby -- General Dense Matrix Sum -
            • psb_gedot -- Dot Product
            • psb_gedots -- Generalized Dot Product + HREF="node27.html">Computational routines + -
              + HREF="node36.html">psb_genrm2s -- Generalized 2-Norm of Vector
            • Communication routines - +
            • psb_gather -- Gather Global Dense Matrix + HREF="node40.html">Communication routines + -
              + HREF="node41.html">psb_halo -- Halo Data Communication
            • Data management routines - +
            • psb_cdasb -- Communication descriptor assembly routine + HREF="node45.html">Data management routines + -
              + HREF="node69.html">psb_get_overlap -- Extract list of overlap elements
            • Parallel environment routines -
              -
            • Error handling +
            • Parallel environment routines +
            • psb_set_errverbosity -- Sets the verbosity of error - messages. + HREF="node90.html">Error handling +
              -
            • Utilities -
                -
              • hb_read -- Read a sparse matrix from a file in the - Harwell-Boeing format -
              • hb_write -- Write a sparse matrix to a file - in the Harwell-Boeing format
              • mm_mat_read -- Read a sparse matrix from a - file in the MatrixMarket format + HREF="node95.html">Utilities +
                -
              • Preconditioner routines -

                diff --git a/docs/psblas-3.0.pdf b/docs/psblas-3.0.pdf index 24782a134..fcd9aaa0a 100644 --- a/docs/psblas-3.0.pdf +++ b/docs/psblas-3.0.pdf @@ -76,564 +76,576 @@ endobj << /S /GoTo /D (subsection.3.3) >> endobj 56 0 obj -(3.3 Preconditioner data structure) +(3.3 Dense Vector Data Structure) endobj 57 0 obj -<< /S /GoTo /D (subsection.3.4) >> +<< /S /GoTo /D (subsubsection.3.3.1) >> endobj 60 0 obj -(3.4 Data structure query routines) +(3.3.1 Named Constants) endobj 61 0 obj -<< /S /GoTo /D (section*.2) >> +<< /S /GoTo /D (subsection.3.4) >> endobj 64 0 obj -(psb\137cd\137get\137local\137rows ) +(3.4 Preconditioner data structure) endobj 65 0 obj -<< /S /GoTo /D (section*.3) >> +<< /S /GoTo /D (subsection.3.5) >> endobj 68 0 obj -(psb\137cd\137get\137local\137cols ) +(3.5 Data structure query routines) endobj 69 0 obj -<< /S /GoTo /D (section*.4) >> +<< /S /GoTo /D (section*.2) >> endobj 72 0 obj -(psb\137cd\137get\137global\137rows ) +(get\137local\137rows ) endobj 73 0 obj -<< /S /GoTo /D (section*.5) >> +<< /S /GoTo /D (section*.3) >> endobj 76 0 obj -(psb\137cd\137get\137global\137cols ) +(get\137local\137cols ) endobj 77 0 obj -<< /S /GoTo /D (section*.6) >> +<< /S /GoTo /D (section*.4) >> endobj 80 0 obj -(psb\137cd\137get\137context) +(get\137global\137rows ) endobj 81 0 obj -<< /S /GoTo /D (section*.7) >> +<< /S /GoTo /D (section*.5) >> endobj 84 0 obj -(psb\137cd\137get\137large\137threshold) +(get\137global\137cols ) endobj 85 0 obj -<< /S /GoTo /D (section*.8) >> +<< /S /GoTo /D (section*.6) >> endobj 88 0 obj -(psb\137cd\137set\137large\137threshold) +(get\137context) endobj 89 0 obj -<< /S /GoTo /D (section*.9) >> +<< /S /GoTo /D (section*.7) >> endobj 92 0 obj -( psb\137sp\137get\137nrows) +(psb\137cd\137get\137large\137threshold) endobj 93 0 obj -<< /S /GoTo /D (section*.10) >> +<< /S /GoTo /D (section*.8) >> endobj 96 0 obj -(psb\137sp\137get\137ncols) +(psb\137cd\137set\137large\137threshold) endobj 97 0 obj -<< /S /GoTo /D (section*.11) >> +<< /S /GoTo /D (section*.9) >> endobj 100 0 obj -(psb\137sp\137get\137nnzeros) +(get\137nrows) endobj 101 0 obj -<< /S /GoTo /D (section.4) >> +<< /S /GoTo /D (section*.10) >> endobj 104 0 obj -(4 Computational routines) +(get\137ncols) endobj 105 0 obj -<< /S /GoTo /D (section*.12) >> +<< /S /GoTo /D (section*.11) >> endobj 108 0 obj -(psb\137geaxpby) +(get\137nnzeros) endobj 109 0 obj -<< /S /GoTo /D (section*.13) >> +<< /S /GoTo /D (section.4) >> endobj 112 0 obj -(psb\137gedot) +(4 Computational routines) endobj 113 0 obj -<< /S /GoTo /D (section*.14) >> +<< /S /GoTo /D (section*.12) >> endobj 116 0 obj -(psb\137gedots) +(psb\137geaxpby) endobj 117 0 obj -<< /S /GoTo /D (section*.15) >> +<< /S /GoTo /D (section*.13) >> endobj 120 0 obj -(psb\137geamax) +(psb\137gedot) endobj 121 0 obj -<< /S /GoTo /D (section*.16) >> +<< /S /GoTo /D (section*.14) >> endobj 124 0 obj -(psb\137geamaxs) +(psb\137gedots) endobj 125 0 obj -<< /S /GoTo /D (section*.17) >> +<< /S /GoTo /D (section*.15) >> endobj 128 0 obj -(psb\137geasum) +(psb\137geamax) endobj 129 0 obj -<< /S /GoTo /D (section*.18) >> +<< /S /GoTo /D (section*.16) >> endobj 132 0 obj -(psb\137geasums) +(psb\137geamaxs) endobj 133 0 obj -<< /S /GoTo /D (section*.19) >> +<< /S /GoTo /D (section*.17) >> endobj 136 0 obj -(psb\137geasums) +(psb\137geasum) endobj 137 0 obj -<< /S /GoTo /D (section*.20) >> +<< /S /GoTo /D (section*.18) >> endobj 140 0 obj -(psb\137genrm2s) +(psb\137geasums) endobj 141 0 obj -<< /S /GoTo /D (section*.21) >> +<< /S /GoTo /D (section*.19) >> endobj 144 0 obj -(psb\137spnrmi) +(psb\137geasums) endobj 145 0 obj -<< /S /GoTo /D (section*.22) >> +<< /S /GoTo /D (section*.20) >> endobj 148 0 obj -(psb\137spmm) +(psb\137genrm2s) endobj 149 0 obj -<< /S /GoTo /D (section*.23) >> +<< /S /GoTo /D (section*.21) >> endobj 152 0 obj -(psb\137spsm) +(psb\137spnrmi) endobj 153 0 obj -<< /S /GoTo /D (section.5) >> +<< /S /GoTo /D (section*.22) >> endobj 156 0 obj -(5 Communication routines) +(psb\137spmm) endobj 157 0 obj -<< /S /GoTo /D (section*.24) >> +<< /S /GoTo /D (section*.23) >> endobj 160 0 obj -(psb\137halo) +(psb\137spsm) endobj 161 0 obj -<< /S /GoTo /D (section*.25) >> +<< /S /GoTo /D (section.5) >> endobj 164 0 obj -(psb\137ovrl) +(5 Communication routines) endobj 165 0 obj -<< /S /GoTo /D (section*.26) >> +<< /S /GoTo /D (section*.24) >> endobj 168 0 obj -(psb\137gather) +(psb\137halo) endobj 169 0 obj -<< /S /GoTo /D (section*.27) >> +<< /S /GoTo /D (section*.25) >> endobj 172 0 obj -(psb\137scatter) +(psb\137ovrl) endobj 173 0 obj -<< /S /GoTo /D (section.6) >> +<< /S /GoTo /D (section*.26) >> endobj 176 0 obj -(6 Data management routines) +(psb\137gather) endobj 177 0 obj -<< /S /GoTo /D (section*.28) >> +<< /S /GoTo /D (section*.27) >> endobj 180 0 obj -(psb\137cdall) +(psb\137scatter) endobj 181 0 obj -<< /S /GoTo /D (section*.29) >> +<< /S /GoTo /D (section.6) >> endobj 184 0 obj -(psb\137cdins) +(6 Data management routines) endobj 185 0 obj -<< /S /GoTo /D (section*.30) >> +<< /S /GoTo /D (section*.28) >> endobj 188 0 obj -(psb\137cdasb) +(psb\137cdall) endobj 189 0 obj -<< /S /GoTo /D (section*.31) >> +<< /S /GoTo /D (section*.29) >> endobj 192 0 obj -(psb\137cdcpy) +(psb\137cdins) endobj 193 0 obj -<< /S /GoTo /D (section*.32) >> +<< /S /GoTo /D (section*.30) >> endobj 196 0 obj -(psb\137cdfree) +(psb\137cdasb) endobj 197 0 obj -<< /S /GoTo /D (section*.33) >> +<< /S /GoTo /D (section*.31) >> endobj 200 0 obj -(psb\137cdbldext) +(psb\137cdcpy) endobj 201 0 obj -<< /S /GoTo /D (section*.34) >> +<< /S /GoTo /D (section*.32) >> endobj 204 0 obj -(psb\137spall) +(psb\137cdfree) endobj 205 0 obj -<< /S /GoTo /D (section*.35) >> +<< /S /GoTo /D (section*.33) >> endobj 208 0 obj -(psb\137spins) +(psb\137cdbldext) endobj 209 0 obj -<< /S /GoTo /D (section*.36) >> +<< /S /GoTo /D (section*.34) >> endobj 212 0 obj -(psb\137spasb) +(psb\137spall) endobj 213 0 obj -<< /S /GoTo /D (section*.37) >> +<< /S /GoTo /D (section*.35) >> endobj 216 0 obj -(psb\137spfree) +(psb\137spins) endobj 217 0 obj -<< /S /GoTo /D (section*.38) >> +<< /S /GoTo /D (section*.36) >> endobj 220 0 obj -(psb\137sprn) +(psb\137spasb) endobj 221 0 obj -<< /S /GoTo /D (section*.39) >> +<< /S /GoTo /D (section*.37) >> endobj 224 0 obj -(psb\137geall) +(psb\137spfree) endobj 225 0 obj -<< /S /GoTo /D (section*.40) >> +<< /S /GoTo /D (section*.38) >> endobj 228 0 obj -(psb\137geins) +(psb\137sprn) endobj 229 0 obj -<< /S /GoTo /D (section*.41) >> +<< /S /GoTo /D (section*.39) >> endobj 232 0 obj -(psb\137geasb) +(psb\137geall) endobj 233 0 obj -<< /S /GoTo /D (section*.42) >> +<< /S /GoTo /D (section*.40) >> endobj 236 0 obj -(psb\137gefree) +(psb\137geins) endobj 237 0 obj -<< /S /GoTo /D (section*.43) >> +<< /S /GoTo /D (section*.41) >> endobj 240 0 obj -(psb\137gelp) +(psb\137geasb) endobj 241 0 obj -<< /S /GoTo /D (section*.44) >> +<< /S /GoTo /D (section*.42) >> endobj 244 0 obj -(psb\137glob\137to\137loc) +(psb\137gefree) endobj 245 0 obj -<< /S /GoTo /D (section*.45) >> +<< /S /GoTo /D (section*.43) >> endobj 248 0 obj -(psb\137loc\137to\137glob) +(psb\137gelp) endobj 249 0 obj -<< /S /GoTo /D (section*.46) >> +<< /S /GoTo /D (section*.44) >> endobj 252 0 obj -(psb\137is\137owned) +(psb\137glob\137to\137loc) endobj 253 0 obj -<< /S /GoTo /D (section*.47) >> +<< /S /GoTo /D (section*.45) >> endobj 256 0 obj -(psb\137owned\137index) +(psb\137loc\137to\137glob) endobj 257 0 obj -<< /S /GoTo /D (section*.48) >> +<< /S /GoTo /D (section*.46) >> endobj 260 0 obj -(psb\137is\137local) +(psb\137is\137owned) endobj 261 0 obj -<< /S /GoTo /D (section*.49) >> +<< /S /GoTo /D (section*.47) >> endobj 264 0 obj -(psb\137local\137index) +(psb\137owned\137index) endobj 265 0 obj -<< /S /GoTo /D (section*.50) >> +<< /S /GoTo /D (section*.48) >> endobj 268 0 obj -(psb\137get\137boundary) +(psb\137is\137local) endobj 269 0 obj -<< /S /GoTo /D (section*.51) >> +<< /S /GoTo /D (section*.49) >> endobj 272 0 obj -(psb\137get\137overlap) +(psb\137local\137index) endobj 273 0 obj -<< /S /GoTo /D (section*.52) >> +<< /S /GoTo /D (section*.50) >> endobj 276 0 obj -(psb\137sp\137getrow) +(psb\137get\137boundary) endobj 277 0 obj -<< /S /GoTo /D (section*.53) >> +<< /S /GoTo /D (section*.51) >> endobj 280 0 obj -(psb\137sizeof) +(psb\137get\137overlap) endobj 281 0 obj -<< /S /GoTo /D (section*.54) >> +<< /S /GoTo /D (section*.52) >> endobj 284 0 obj -(Sorting utilities) +(psb\137sp\137getrow) endobj 285 0 obj -<< /S /GoTo /D (section.7) >> +<< /S /GoTo /D (section*.53) >> endobj 288 0 obj -(7 Parallel environment routines) +(psb\137sizeof) endobj 289 0 obj -<< /S /GoTo /D (section*.55) >> +<< /S /GoTo /D (section*.54) >> endobj 292 0 obj -(psb\137init) +(Sorting utilities) endobj 293 0 obj -<< /S /GoTo /D (section*.56) >> +<< /S /GoTo /D (section.7) >> endobj 296 0 obj -(psb\137info) +(7 Parallel environment routines) endobj 297 0 obj -<< /S /GoTo /D (section*.57) >> +<< /S /GoTo /D (section*.55) >> endobj 300 0 obj -(psb\137exit) +(psb\137init) endobj 301 0 obj -<< /S /GoTo /D (section*.58) >> +<< /S /GoTo /D (section*.56) >> endobj 304 0 obj -(psb\137get\137mpicomm) +(psb\137info) endobj 305 0 obj -<< /S /GoTo /D (section*.59) >> +<< /S /GoTo /D (section*.57) >> endobj 308 0 obj -(psb\137get\137rank) +(psb\137exit) endobj 309 0 obj -<< /S /GoTo /D (section*.60) >> +<< /S /GoTo /D (section*.58) >> endobj 312 0 obj -(psb\137wtime) +(psb\137get\137mpicomm) endobj 313 0 obj -<< /S /GoTo /D (section*.61) >> +<< /S /GoTo /D (section*.59) >> endobj 316 0 obj -(psb\137barrier) +(psb\137get\137rank) endobj 317 0 obj -<< /S /GoTo /D (section*.62) >> +<< /S /GoTo /D (section*.60) >> endobj 320 0 obj -(psb\137abort) +(psb\137wtime) endobj 321 0 obj -<< /S /GoTo /D (section*.63) >> +<< /S /GoTo /D (section*.61) >> endobj 324 0 obj -(psb\137bcast) +(psb\137barrier) endobj 325 0 obj -<< /S /GoTo /D (section*.64) >> +<< /S /GoTo /D (section*.62) >> endobj 328 0 obj -(psb\137sum) +(psb\137abort) endobj 329 0 obj -<< /S /GoTo /D (section*.65) >> +<< /S /GoTo /D (section*.63) >> endobj 332 0 obj -(psb\137max) +(psb\137bcast) endobj 333 0 obj -<< /S /GoTo /D (section*.66) >> +<< /S /GoTo /D (section*.64) >> endobj 336 0 obj -(psb\137min) +(psb\137sum) endobj 337 0 obj -<< /S /GoTo /D (section*.67) >> +<< /S /GoTo /D (section*.65) >> endobj 340 0 obj -(psb\137amx) +(psb\137max) endobj 341 0 obj -<< /S /GoTo /D (section*.68) >> +<< /S /GoTo /D (section*.66) >> endobj 344 0 obj -(psb\137amn) +(psb\137min) endobj 345 0 obj -<< /S /GoTo /D (section*.69) >> +<< /S /GoTo /D (section*.67) >> endobj 348 0 obj -(psb\137snd) +(psb\137amx) endobj 349 0 obj -<< /S /GoTo /D (section*.70) >> +<< /S /GoTo /D (section*.68) >> endobj 352 0 obj -(psb\137rcv) +(psb\137amn) endobj 353 0 obj -<< /S /GoTo /D (section.8) >> +<< /S /GoTo /D (section*.69) >> endobj 356 0 obj -(8 Error handling) +(psb\137snd) endobj 357 0 obj -<< /S /GoTo /D (section*.71) >> +<< /S /GoTo /D (section*.70) >> endobj 360 0 obj -(psb\137errpush) +(psb\137rcv) endobj 361 0 obj -<< /S /GoTo /D (section*.72) >> +<< /S /GoTo /D (section.8) >> endobj 364 0 obj -(psb\137error) +(8 Error handling) endobj 365 0 obj -<< /S /GoTo /D (section*.73) >> +<< /S /GoTo /D (section*.71) >> endobj 368 0 obj -(psb\137set\137errverbosity) +(psb\137errpush) endobj 369 0 obj -<< /S /GoTo /D (section*.74) >> +<< /S /GoTo /D (section*.72) >> endobj 372 0 obj -(psb\137set\137erraction) +(psb\137error) endobj 373 0 obj -<< /S /GoTo /D (section.9) >> +<< /S /GoTo /D (section*.73) >> endobj 376 0 obj -(9 Utilities) +(psb\137set\137errverbosity) endobj 377 0 obj -<< /S /GoTo /D (section*.75) >> +<< /S /GoTo /D (section*.74) >> endobj 380 0 obj -(hb\137read) +(psb\137set\137erraction) endobj 381 0 obj -<< /S /GoTo /D (section*.76) >> +<< /S /GoTo /D (section.9) >> endobj 384 0 obj -(hb\137write) +(9 Utilities) endobj 385 0 obj -<< /S /GoTo /D (section*.77) >> +<< /S /GoTo /D (section*.75) >> endobj 388 0 obj -(mm\137mat\137read) +(hb\137read) endobj 389 0 obj -<< /S /GoTo /D (section*.78) >> +<< /S /GoTo /D (section*.76) >> endobj 392 0 obj -(mm\137vet\137read ) +(hb\137write) endobj 393 0 obj -<< /S /GoTo /D (section*.79) >> +<< /S /GoTo /D (section*.77) >> endobj 396 0 obj -(mm\137mat\137write) +(mm\137mat\137read) endobj 397 0 obj -<< /S /GoTo /D (section.10) >> +<< /S /GoTo /D (section*.78) >> endobj 400 0 obj -(10 Preconditioner routines) +(mm\137vet\137read ) endobj 401 0 obj -<< /S /GoTo /D (section*.80) >> +<< /S /GoTo /D (section*.79) >> endobj 404 0 obj -(psb\137precinit) +(mm\137mat\137write) endobj 405 0 obj -<< /S /GoTo /D (section*.81) >> +<< /S /GoTo /D (section.10) >> endobj 408 0 obj -(psb\137precbld) +(10 Preconditioner routines) endobj 409 0 obj -<< /S /GoTo /D (section*.82) >> +<< /S /GoTo /D (section*.80) >> endobj 412 0 obj -(psb\137precaply) +(psb\137precinit) endobj 413 0 obj -<< /S /GoTo /D (section*.83) >> +<< /S /GoTo /D (section*.81) >> endobj 416 0 obj -(psb\137precdescr) +(psb\137precbld) endobj 417 0 obj -<< /S /GoTo /D (section.11) >> +<< /S /GoTo /D (section*.82) >> endobj 420 0 obj -(11 Iterative Methods) +(psb\137precaply) endobj 421 0 obj -<< /S /GoTo /D (section*.84) >> +<< /S /GoTo /D (section*.83) >> endobj 424 0 obj -(krylov) +(psb\137precdescr) endobj 425 0 obj -<< /S /GoTo /D [426 0 R /Fit ] >> +<< /S /GoTo /D (section.11) >> endobj -428 0 obj << +428 0 obj +(11 Iterative Methods) +endobj +429 0 obj +<< /S /GoTo /D (section*.84) >> +endobj +432 0 obj +(krylov) +endobj +433 0 obj +<< /S /GoTo /D [434 0 R /Fit ] >> +endobj +436 0 obj << /Length 715 >> stream @@ -659,27 +671,27 @@ BT ET endstream endobj -426 0 obj << +434 0 obj << /Type /Page -/Contents 428 0 R -/Resources 427 0 R +/Contents 436 0 R +/Resources 435 0 R /MediaBox [0 0 595.276 841.89] -/Parent 435 0 R +/Parent 443 0 R >> endobj -429 0 obj << -/D [426 0 R /XYZ 99.895 740.998 null] ->> endobj -430 0 obj << -/D [426 0 R /XYZ 99.895 716.092 null] ->> endobj -6 0 obj << -/D [426 0 R /XYZ 99.895 716.092 null] ->> endobj -427 0 obj << -/Font << /F16 431 0 R /F18 432 0 R /F27 433 0 R /F8 434 0 R >> -/ProcSet [ /PDF /Text ] +437 0 obj << +/D [434 0 R /XYZ 99.895 740.998 null] >> endobj 438 0 obj << +/D [434 0 R /XYZ 99.895 716.092 null] +>> endobj +6 0 obj << +/D [434 0 R /XYZ 99.895 716.092 null] +>> endobj +435 0 obj << +/Font << /F16 439 0 R /F18 440 0 R /F27 441 0 R /F8 442 0 R >> +/ProcSet [ /PDF /Text ] +>> endobj +446 0 obj << /Length 77 >> stream @@ -692,22 +704,22 @@ BT ET endstream endobj -437 0 obj << +445 0 obj << /Type /Page -/Contents 438 0 R -/Resources 436 0 R +/Contents 446 0 R +/Resources 444 0 R /MediaBox [0 0 595.276 841.89] -/Parent 435 0 R +/Parent 443 0 R >> endobj -439 0 obj << -/D [437 0 R /XYZ 150.705 740.998 null] +447 0 obj << +/D [445 0 R /XYZ 150.705 740.998 null] >> endobj -436 0 obj << -/Font << /F8 434 0 R >> +444 0 obj << +/Font << /F8 442 0 R >> /ProcSet [ /PDF /Text ] >> endobj -486 0 obj << -/Length 17640 +494 0 obj << +/Length 16611 >> stream 0 g 0 G @@ -715,629 +727,531 @@ stream BT /F16 14.3462 Tf 99.895 706.129 Td [(Con)31(ten)31(ts)]TJ 0 0 1 rg 0 0 1 RG -/F27 9.9626 Tf 0 -23.641 Td [(1)-925(In)32(tro)-32(duction)]TJ +/F27 9.9626 Tf 0 -22.706 Td [(1)-925(In)32(tro)-32(duction)]TJ 0 g 0 G [-26085(1)]TJ 0 0 1 rg 0 0 1 RG - 0 -23.641 Td [(2)-925(General)-383(o)32(v)31(erview)]TJ + 0 -22.707 Td [(2)-925(General)-383(o)32(v)31(erview)]TJ 0 g 0 G [-23689(2)]TJ 0 0 1 rg 0 0 1 RG -/F8 9.9626 Tf 14.944 -12.988 Td [(2.1)-1022(Basic)-334(Nomenclature)]TJ +/F8 9.9626 Tf 14.944 -12.428 Td [(2.1)-1022(Basic)-334(Nomenclature)]TJ 0 g 0 G [-927(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-1583(3)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - 0 -12.989 Td [(2.2)-1022(Library)-333(con)27(ten)28(ts)]TJ + 0 -12.428 Td [(2.2)-1022(Library)-333(con)27(ten)28(ts)]TJ 0 g 0 G [-897(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-1584(4)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - 0 -12.989 Td [(2.3)-1022(Application)-333(structure)]TJ + 0 -12.428 Td [(2.3)-1022(Application)-333(structure)]TJ 0 g 0 G [-300(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)]TJ 0 g 0 G [-1584(6)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - 0 -12.989 Td [(2.4)-1022(Programming)-334(mo)-27(del)]TJ + 0 -12.428 Td [(2.4)-1022(Programming)-334(mo)-27(del)]TJ 0 g 0 G [-736(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)]TJ 0 g 0 G [-1584(8)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -/F27 9.9626 Tf -14.944 -23.641 Td [(3)-925(Data)-383(Struct)-1(ure)1(s)]TJ +/F27 9.9626 Tf -14.944 -22.707 Td [(3)-925(Data)-383(Struct)-1(ure)1(s)]TJ 0 g 0 G [-24345(9)]TJ 0 0 1 rg 0 0 1 RG -/F8 9.9626 Tf 14.944 -12.989 Td [(3.1)-1022(Descriptor)-334(data)-333(structure)]TJ +/F8 9.9626 Tf 14.944 -12.428 Td [(3.1)-1022(Descriptor)-334(data)-333(structure)]TJ 0 g 0 G [-886(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-1584(9)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - 22.914 -12.988 Td [(3.1.1)-1144(Nam)-1(ed)-333(Constan)28(ts)]TJ + 22.914 -12.428 Td [(3.1.1)-1144(Nam)-1(ed)-333(Constan)28(ts)]TJ 0 g 0 G [-1016(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-1084(11)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -22.914 -12.989 Td [(3.2)-1022(Sparse)-334(Matr)1(ix)-334(data)-333(structure)]TJ + -22.914 -12.428 Td [(3.2)-1022(Sparse)-334(Matr)1(ix)-334(data)-333(structure)]TJ 0 g 0 G [-816(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-1084(11)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - 22.914 -12.989 Td [(3.2.1)-1144(Nam)-1(ed)-333(Constan)28(ts)]TJ + 22.914 -12.429 Td [(3.2.1)-1144(Nam)-1(ed)-333(Constan)28(ts)]TJ 0 g 0 G [-1016(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-1084(14)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -22.914 -12.989 Td [(3.3)-1022(Preconditioner)-333(data)-334(structure)]TJ + -22.914 -12.428 Td [(3.3)-1022(Dense)-334(V)84(ector)-334(Data)-333(Structure)]TJ 0 g 0 G - [-586(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ + [-852(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-1084(14)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - 0 -12.989 Td [(3.4)-1022(Data)-334(structure)-333(query)-333(routines)]TJ + 22.914 -12.428 Td [(3.3.1)-1144(Name)-1(d)-333(Constan)28(ts)]TJ 0 g 0 G - [-497(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)]TJ -0 g 0 G - [-1084(14)]TJ -0 g 0 G -0 0 1 rg 0 0 1 RG - 22.914 -12.989 Td [(psb)]TJ -ET -q -1 0 0 1 153.351 492.528 cm -[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S -Q -BT -/F8 9.9626 Tf 156.339 492.329 Td [(cd)]TJ -ET -q -1 0 0 1 166.9 492.528 cm -[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S -Q -BT -/F8 9.9626 Tf 169.889 492.329 Td [(get)]TJ -ET -q -1 0 0 1 183.77 492.528 cm -[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S -Q -BT -/F8 9.9626 Tf 186.759 492.329 Td [(lo)-28(cal)]TJ -ET -q -1 0 0 1 207.559 492.528 cm -[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S -Q -BT -/F8 9.9626 Tf 210.547 492.329 Td [(ro)28(ws)]TJ -0 g 0 G - [-1163(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ -0 g 0 G - [-1084(14)]TJ -0 g 0 G -0 0 1 rg 0 0 1 RG - -72.794 -12.989 Td [(psb)]TJ -ET -q -1 0 0 1 153.351 479.539 cm -[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S -Q -BT -/F8 9.9626 Tf 156.339 479.34 Td [(cd)]TJ -ET -q -1 0 0 1 166.9 479.539 cm -[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S -Q -BT -/F8 9.9626 Tf 169.889 479.34 Td [(get)]TJ -ET -q -1 0 0 1 183.77 479.539 cm -[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S -Q -BT -/F8 9.9626 Tf 186.759 479.34 Td [(lo)-28(cal)]TJ -ET -q -1 0 0 1 207.559 479.539 cm -[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S -Q -BT -/F8 9.9626 Tf 210.547 479.34 Td [(cols)]TJ -0 g 0 G - [-749(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ -0 g 0 G - [-1084(15)]TJ -0 g 0 G -0 0 1 rg 0 0 1 RG - -72.794 -12.989 Td [(psb)]TJ -ET -q -1 0 0 1 153.351 466.551 cm -[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S -Q -BT -/F8 9.9626 Tf 156.339 466.351 Td [(cd)]TJ -ET -q -1 0 0 1 166.9 466.551 cm -[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S -Q -BT -/F8 9.9626 Tf 169.889 466.351 Td [(get)]TJ -ET -q -1 0 0 1 183.77 466.551 cm -[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S -Q -BT -/F8 9.9626 Tf 186.759 466.351 Td [(global)]TJ -ET -q -1 0 0 1 213.37 466.551 cm -[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S -Q -BT -/F8 9.9626 Tf 216.359 466.351 Td [(ro)28(ws)]TJ -0 g 0 G - [-1357(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ -0 g 0 G - [-1083(16)]TJ -0 g 0 G -0 0 1 rg 0 0 1 RG - -78.605 -12.989 Td [(psb)]TJ -ET -q -1 0 0 1 153.351 453.562 cm -[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S -Q -BT -/F8 9.9626 Tf 156.339 453.362 Td [(cd)]TJ -ET -q -1 0 0 1 166.9 453.562 cm -[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S -Q -BT -/F8 9.9626 Tf 169.889 453.362 Td [(get)]TJ -ET -q -1 0 0 1 183.77 453.562 cm -[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S -Q -BT -/F8 9.9626 Tf 186.759 453.362 Td [(global)]TJ -ET -q -1 0 0 1 213.37 453.562 cm -[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S -Q -BT -/F8 9.9626 Tf 216.359 453.362 Td [(cols)]TJ -0 g 0 G - [-943(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)]TJ + [-1016(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-1084(16)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -78.605 -12.988 Td [(psb)]TJ -ET -q -1 0 0 1 153.351 440.573 cm -[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S -Q -BT -/F8 9.9626 Tf 156.339 440.374 Td [(cd)]TJ -ET -q -1 0 0 1 166.9 440.573 cm -[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S -Q -BT -/F8 9.9626 Tf 169.889 440.374 Td [(get)]TJ -ET -q -1 0 0 1 183.77 440.573 cm -[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S -Q -BT -/F8 9.9626 Tf 186.759 440.374 Td [(con)28(text)]TJ + -22.914 -12.428 Td [(3.4)-1022(Preconditioner)-333(data)-334(structure)]TJ 0 g 0 G - [-753(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ + [-586(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ +0 g 0 G + [-1084(17)]TJ +0 g 0 G +0 0 1 rg 0 0 1 RG + 0 -12.428 Td [(3.5)-1022(Data)-334(structure)-333(query)-333(routines)]TJ +0 g 0 G + [-497(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)]TJ +0 g 0 G + [-1084(17)]TJ +0 g 0 G +0 0 1 rg 0 0 1 RG + 22.914 -12.429 Td [(get)]TJ +ET +q +1 0 0 1 151.635 476.643 cm +[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S +Q +BT +/F8 9.9626 Tf 154.624 476.443 Td [(lo)-28(cal)]TJ +ET +q +1 0 0 1 175.423 476.643 cm +[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S +Q +BT +/F8 9.9626 Tf 178.412 476.443 Td [(ro)28(ws)]TJ +0 g 0 G + [-1277(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-1083(17)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -49.005 -12.989 Td [(psb)]TJ + -40.659 -12.428 Td [(get)]TJ ET q -1 0 0 1 153.351 427.584 cm +1 0 0 1 151.635 464.214 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 156.339 427.385 Td [(cd)]TJ +/F8 9.9626 Tf 154.624 464.015 Td [(lo)-28(cal)]TJ ET q -1 0 0 1 166.9 427.584 cm +1 0 0 1 175.423 464.214 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 169.889 427.385 Td [(get)]TJ +/F8 9.9626 Tf 178.412 464.015 Td [(cols)]TJ +0 g 0 G + [-863(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)]TJ +0 g 0 G + [-1084(17)]TJ +0 g 0 G +0 0 1 rg 0 0 1 RG + -40.659 -12.428 Td [(get)]TJ ET q -1 0 0 1 183.77 427.584 cm +1 0 0 1 151.635 451.786 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 186.759 427.385 Td [(large)]TJ +/F8 9.9626 Tf 154.624 451.587 Td [(global)]TJ ET q -1 0 0 1 208.416 427.584 cm +1 0 0 1 181.235 451.786 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 211.405 427.385 Td [(threshold)]TJ +/F8 9.9626 Tf 184.224 451.587 Td [(ro)28(ws)]TJ +0 g 0 G + [-694(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ +0 g 0 G + [-1084(19)]TJ +0 g 0 G +0 0 1 rg 0 0 1 RG + -46.47 -12.428 Td [(get)]TJ +ET +q +1 0 0 1 151.635 439.358 cm +[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S +Q +BT +/F8 9.9626 Tf 154.624 439.159 Td [(global)]TJ +ET +q +1 0 0 1 181.235 439.358 cm +[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S +Q +BT +/F8 9.9626 Tf 184.224 439.159 Td [(cols)]TJ +0 g 0 G + [-1058(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ +0 g 0 G + [-1084(19)]TJ +0 g 0 G +0 0 1 rg 0 0 1 RG + -46.47 -12.428 Td [(get)]TJ +ET +q +1 0 0 1 151.635 426.93 cm +[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S +Q +BT +/F8 9.9626 Tf 154.624 426.731 Td [(con)28(text)]TJ +0 g 0 G + [-868(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ +0 g 0 G + [-1084(19)]TJ +0 g 0 G +0 0 1 rg 0 0 1 RG + -16.87 -12.429 Td [(psb)]TJ +ET +q +1 0 0 1 153.351 414.502 cm +[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S +Q +BT +/F8 9.9626 Tf 156.339 414.302 Td [(cd)]TJ +ET +q +1 0 0 1 166.9 414.502 cm +[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S +Q +BT +/F8 9.9626 Tf 169.889 414.302 Td [(get)]TJ +ET +q +1 0 0 1 183.77 414.502 cm +[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S +Q +BT +/F8 9.9626 Tf 186.759 414.302 Td [(large)]TJ +ET +q +1 0 0 1 208.416 414.502 cm +[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S +Q +BT +/F8 9.9626 Tf 211.405 414.302 Td [(threshold)]TJ 0 g 0 G [-549(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-1084(17)]TJ + [-1084(20)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -73.652 -12.989 Td [(psb)]TJ + -73.652 -12.428 Td [(psb)]TJ ET q -1 0 0 1 153.351 414.595 cm +1 0 0 1 153.351 402.073 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 156.339 414.396 Td [(cd)]TJ +/F8 9.9626 Tf 156.339 401.874 Td [(cd)]TJ ET q -1 0 0 1 166.9 414.595 cm +1 0 0 1 166.9 402.073 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 169.889 414.396 Td [(set)]TJ +/F8 9.9626 Tf 169.889 401.874 Td [(set)]TJ ET q -1 0 0 1 182.718 414.595 cm +1 0 0 1 182.718 402.073 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 185.707 414.396 Td [(large)]TJ +/F8 9.9626 Tf 185.707 401.874 Td [(large)]TJ ET q -1 0 0 1 207.365 414.595 cm +1 0 0 1 207.365 402.073 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 210.354 414.396 Td [(threshold)]TJ +/F8 9.9626 Tf 210.354 401.874 Td [(threshold)]TJ 0 g 0 G [-654(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)]TJ 0 g 0 G - [-1084(17)]TJ + [-1084(20)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -69.28 -12.989 Td [(psb)]TJ + -72.601 -12.428 Td [(get)]TJ ET q -1 0 0 1 156.671 401.606 cm +1 0 0 1 151.635 389.645 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 159.66 401.407 Td [(sp)]TJ -ET -q -1 0 0 1 169.723 401.606 cm -[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S -Q -BT -/F8 9.9626 Tf 172.711 401.407 Td [(get)]TJ -ET -q -1 0 0 1 186.593 401.606 cm -[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S -Q -BT -/F8 9.9626 Tf 189.581 401.407 Td [(nro)28(ws)]TJ +/F8 9.9626 Tf 154.624 389.446 Td [(nro)28(ws)]TJ 0 g 0 G - [-378(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ + [-776(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-1083(18)]TJ + [-1084(20)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -51.828 -12.989 Td [(psb)]TJ + -16.87 -12.428 Td [(get)]TJ ET q -1 0 0 1 153.351 388.617 cm +1 0 0 1 151.635 377.217 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 156.339 388.418 Td [(sp)]TJ -ET -q -1 0 0 1 166.402 388.617 cm -[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S -Q -BT -/F8 9.9626 Tf 169.39 388.418 Td [(get)]TJ -ET -q -1 0 0 1 183.272 388.617 cm -[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S -Q -BT -/F8 9.9626 Tf 186.261 388.418 Td [(ncols)]TJ +/F8 9.9626 Tf 154.624 377.018 Td [(ncols)]TJ 0 g 0 G - [-298(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ -0 g 0 G - [-1084(18)]TJ -0 g 0 G -0 0 1 rg 0 0 1 RG - -48.508 -12.989 Td [(psb)]TJ -ET -q -1 0 0 1 153.351 375.628 cm -[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S -Q -BT -/F8 9.9626 Tf 156.339 375.429 Td [(sp)]TJ -ET -q -1 0 0 1 166.402 375.628 cm -[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S -Q -BT -/F8 9.9626 Tf 169.39 375.429 Td [(get)]TJ -ET -q -1 0 0 1 183.272 375.628 cm -[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S -Q -BT -/F8 9.9626 Tf 186.261 375.429 Td [(nnzeros)]TJ -0 g 0 G - [-739(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)]TJ -0 g 0 G - [-1084(18)]TJ -0 g 0 G -0 0 1 rg 0 0 1 RG -/F27 9.9626 Tf -86.366 -23.641 Td [(4)-925(Computational)-383(r)-1(ou)1(t)-1(ines)]TJ -0 g 0 G - [-19886(20)]TJ -0 0 1 rg 0 0 1 RG -/F8 9.9626 Tf 14.944 -12.988 Td [(psb)]TJ -ET -q -1 0 0 1 130.436 338.999 cm -[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S -Q -BT -/F8 9.9626 Tf 133.425 338.8 Td [(geaxpb)28(y)]TJ -0 g 0 G - [-301(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ + [-362(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-1084(21)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -18.586 -12.989 Td [(psb)]TJ + -16.87 -12.428 Td [(get)]TJ ET q -1 0 0 1 130.436 326.01 cm +1 0 0 1 151.635 364.789 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 133.425 325.811 Td [(gedot)]TJ +/F8 9.9626 Tf 154.624 364.59 Td [(nnzeros)]TJ +0 g 0 G + [-804(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ +0 g 0 G + [-1084(21)]TJ +0 g 0 G +0 0 1 rg 0 0 1 RG +/F27 9.9626 Tf -54.729 -22.707 Td [(4)-925(Computational)-383(r)-1(ou)1(t)-1(ines)]TJ +0 g 0 G + [-19886(22)]TJ +0 0 1 rg 0 0 1 RG +/F8 9.9626 Tf 14.944 -12.428 Td [(psb)]TJ +ET +q +1 0 0 1 130.436 329.654 cm +[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S +Q +BT +/F8 9.9626 Tf 133.425 329.455 Td [(geaxpb)28(y)]TJ +0 g 0 G + [-301(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ +0 g 0 G + [-1084(23)]TJ +0 g 0 G +0 0 1 rg 0 0 1 RG + -18.586 -12.428 Td [(psb)]TJ +ET +q +1 0 0 1 130.436 317.226 cm +[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S +Q +BT +/F8 9.9626 Tf 133.425 317.027 Td [(gedot)]TJ 0 g 0 G [-718(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-1083(23)]TJ + [-1083(25)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -18.586 -12.989 Td [(psb)]TJ + -18.586 -12.428 Td [(psb)]TJ ET q -1 0 0 1 130.436 313.021 cm +1 0 0 1 130.436 304.798 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 133.425 312.822 Td [(gedots)]TJ +/F8 9.9626 Tf 133.425 304.599 Td [(gedots)]TJ 0 g 0 G [-323(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ -0 g 0 G - [-1084(25)]TJ -0 g 0 G -0 0 1 rg 0 0 1 RG - -18.586 -12.989 Td [(psb)]TJ -ET -q -1 0 0 1 130.436 300.032 cm -[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S -Q -BT -/F8 9.9626 Tf 133.425 299.833 Td [(geamax)]TJ -0 g 0 G - [-579(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-1084(27)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -18.586 -12.989 Td [(psb)]TJ + -18.586 -12.429 Td [(psb)]TJ ET q -1 0 0 1 130.436 287.043 cm +1 0 0 1 130.436 292.37 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 133.425 286.844 Td [(geamaxs)]TJ +/F8 9.9626 Tf 133.425 292.17 Td [(geamax)]TJ +0 g 0 G + [-579(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ +0 g 0 G + [-1084(29)]TJ +0 g 0 G +0 0 1 rg 0 0 1 RG + -18.586 -12.428 Td [(psb)]TJ +ET +q +1 0 0 1 130.436 279.941 cm +[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S +Q +BT +/F8 9.9626 Tf 133.425 279.742 Td [(geamaxs)]TJ 0 g 0 G [-962(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ -0 g 0 G - [-1084(28)]TJ -0 g 0 G -0 0 1 rg 0 0 1 RG - -18.586 -12.989 Td [(psb)]TJ -ET -q -1 0 0 1 130.436 274.054 cm -[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S -Q -BT -/F8 9.9626 Tf 133.425 273.855 Td [(geasum)]TJ -0 g 0 G - [-657(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ -0 g 0 G - [-1083(29)]TJ -0 g 0 G -0 0 1 rg 0 0 1 RG - -18.586 -12.989 Td [(psb)]TJ -ET -q -1 0 0 1 130.436 261.066 cm -[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S -Q -BT -/F8 9.9626 Tf 133.425 260.866 Td [(geasums)]TJ -0 g 0 G - [-262(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-1084(30)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -18.586 -12.989 Td [(psb)]TJ + -18.586 -12.428 Td [(psb)]TJ ET q -1 0 0 1 130.436 248.077 cm +1 0 0 1 130.436 267.513 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 133.425 247.877 Td [(geasums)]TJ +/F8 9.9626 Tf 133.425 267.314 Td [(geasum)]TJ +0 g 0 G + [-657(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ +0 g 0 G + [-1083(31)]TJ +0 g 0 G +0 0 1 rg 0 0 1 RG + -18.586 -12.428 Td [(psb)]TJ +ET +q +1 0 0 1 130.436 255.085 cm +[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S +Q +BT +/F8 9.9626 Tf 133.425 254.886 Td [(geasums)]TJ 0 g 0 G [-262(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-1084(32)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -18.586 -12.989 Td [(psb)]TJ + -18.586 -12.428 Td [(psb)]TJ ET q -1 0 0 1 130.436 235.088 cm +1 0 0 1 130.436 242.657 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 133.425 234.889 Td [(genrm2s)]TJ +/F8 9.9626 Tf 133.425 242.458 Td [(geasums)]TJ 0 g 0 G - [-265(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ -0 g 0 G - [-1084(33)]TJ -0 g 0 G -0 0 1 rg 0 0 1 RG - -18.586 -12.989 Td [(psb)]TJ -ET -q -1 0 0 1 130.436 222.099 cm -[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S -Q -BT -/F8 9.9626 Tf 133.425 221.9 Td [(spnrmi)]TJ -0 g 0 G - [-876(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ + [-262(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-1084(34)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -18.586 -12.989 Td [(psb)]TJ + -18.586 -12.429 Td [(psb)]TJ ET q -1 0 0 1 130.436 209.11 cm +1 0 0 1 130.436 230.229 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 133.425 208.911 Td [(spmm)]TJ +/F8 9.9626 Tf 133.425 230.029 Td [(genrm2s)]TJ 0 g 0 G - [-490(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ + [-265(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-1084(35)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -18.586 -12.989 Td [(psb)]TJ + -18.586 -12.428 Td [(psb)]TJ ET q -1 0 0 1 130.436 196.121 cm +1 0 0 1 130.436 217.8 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 133.425 195.922 Td [(spsm)]TJ +/F8 9.9626 Tf 133.425 217.601 Td [(spnrmi)]TJ 0 g 0 G - [-929(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ + [-876(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ +0 g 0 G + [-1084(36)]TJ +0 g 0 G +0 0 1 rg 0 0 1 RG + -18.586 -12.428 Td [(psb)]TJ +ET +q +1 0 0 1 130.436 205.372 cm +[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S +Q +BT +/F8 9.9626 Tf 133.425 205.173 Td [(spmm)]TJ +0 g 0 G + [-490(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G [-1084(37)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -/F27 9.9626 Tf -33.53 -23.641 Td [(5)-925(Comm)32(unication)-384(routines)]TJ -0 g 0 G - [-19454(40)]TJ -0 0 1 rg 0 0 1 RG -/F8 9.9626 Tf 14.944 -12.989 Td [(psb)]TJ + -18.586 -12.428 Td [(psb)]TJ ET q -1 0 0 1 130.436 159.492 cm +1 0 0 1 130.436 192.944 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 133.425 159.292 Td [(halo)]TJ +/F8 9.9626 Tf 133.425 192.745 Td [(spsm)]TJ +0 g 0 G + [-929(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ +0 g 0 G + [-1084(39)]TJ +0 g 0 G +0 0 1 rg 0 0 1 RG +/F27 9.9626 Tf -33.53 -22.707 Td [(5)-925(Comm)32(unication)-384(routines)]TJ +0 g 0 G + [-19454(42)]TJ +0 0 1 rg 0 0 1 RG +/F8 9.9626 Tf 14.944 -12.428 Td [(psb)]TJ +ET +q +1 0 0 1 130.436 157.81 cm +[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S +Q +BT +/F8 9.9626 Tf 133.425 157.61 Td [(halo)]TJ 0 g 0 G [-495(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-1084(41)]TJ + [-1084(43)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -18.586 -12.989 Td [(psb)]TJ + -18.586 -12.428 Td [(psb)]TJ ET q -1 0 0 1 130.436 146.503 cm +1 0 0 1 130.436 145.381 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 133.425 146.303 Td [(o)28(vrl)]TJ +/F8 9.9626 Tf 133.425 145.182 Td [(o)28(vrl)]TJ 0 g 0 G [-660(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)]TJ 0 g 0 G - [-1084(44)]TJ + [-1084(46)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -18.586 -12.988 Td [(psb)]TJ + -18.586 -12.428 Td [(psb)]TJ ET q -1 0 0 1 130.436 133.514 cm +1 0 0 1 130.436 132.953 cm []0 d 0 J 0.398 w 0 0 m 2.989 0 l S Q BT -/F8 9.9626 Tf 133.425 133.315 Td [(gather)]TJ +/F8 9.9626 Tf 133.425 132.754 Td [(gather)]TJ 0 g 0 G [-326(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-1084(48)]TJ + [-1084(50)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG - -18.586 -12.989 Td [(psb)]TJ + -18.586 -12.428 Td [(psb)]TJ ET q 1 0 0 1 130.436 120.525 cm @@ -1348,7 +1262,7 @@ BT 0 g 0 G [-932(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-1083(50)]TJ + [-1083(52)]TJ 0 g 0 G 0 g 0 G 136.942 -29.888 Td [(i)]TJ @@ -1356,312 +1270,326 @@ BT ET endstream endobj -485 0 obj << +493 0 obj << /Type /Page -/Contents 486 0 R -/Resources 484 0 R +/Contents 494 0 R +/Resources 492 0 R /MediaBox [0 0 595.276 841.89] -/Parent 435 0 R -/Annots [ 440 0 R 441 0 R 442 0 R 443 0 R 444 0 R 445 0 R 446 0 R 447 0 R 448 0 R 449 0 R 450 0 R 451 0 R 452 0 R 453 0 R 454 0 R 455 0 R 456 0 R 457 0 R 458 0 R 459 0 R 460 0 R 461 0 R 462 0 R 463 0 R 464 0 R 465 0 R 466 0 R 467 0 R 468 0 R 469 0 R 470 0 R 471 0 R 472 0 R 473 0 R 474 0 R 475 0 R 476 0 R 477 0 R 478 0 R 479 0 R 480 0 R ] ->> endobj -440 0 obj << -/Type /Annot -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [98.899 681.492 179.001 690.403] -/Subtype /Link -/A << /S /GoTo /D (section.1) >> ->> endobj -441 0 obj << -/Type /Annot -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [98.899 657.851 202.863 666.762] -/Subtype /Link -/A << /S /GoTo /D (section.2) >> ->> endobj -442 0 obj << -/Type /Annot -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 644.862 225.868 653.773] -/Subtype /Link -/A << /S /GoTo /D (subsection.2.1) >> ->> endobj -443 0 obj << -/Type /Annot -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 629.936 210.675 640.784] -/Subtype /Link -/A << /S /GoTo /D (subsection.2.2) >> ->> endobj -444 0 obj << -/Type /Annot -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 616.947 232.122 627.796] -/Subtype /Link -/A << /S /GoTo /D (subsection.2.3) >> ->> endobj -445 0 obj << -/Type /Annot -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 603.959 227.777 614.807] -/Subtype /Link -/A << /S /GoTo /D (subsection.2.4) >> ->> endobj -446 0 obj << -/Type /Annot -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [98.899 582.255 196.34 591.083] -/Subtype /Link -/A << /S /GoTo /D (section.3) >> ->> endobj -447 0 obj << -/Type /Annot -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 567.329 249.529 578.177] -/Subtype /Link -/A << /S /GoTo /D (subsection.3.1) >> +/Parent 443 0 R +/Annots [ 448 0 R 449 0 R 450 0 R 451 0 R 452 0 R 453 0 R 454 0 R 455 0 R 456 0 R 457 0 R 458 0 R 459 0 R 460 0 R 461 0 R 462 0 R 463 0 R 464 0 R 465 0 R 466 0 R 467 0 R 468 0 R 469 0 R 470 0 R 471 0 R 472 0 R 473 0 R 474 0 R 475 0 R 476 0 R 477 0 R 478 0 R 479 0 R 480 0 R 481 0 R 482 0 R 483 0 R 484 0 R 485 0 R 486 0 R 487 0 R 488 0 R 489 0 R 490 0 R ] >> endobj 448 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] -/Rect [136.757 556.277 248.228 565.188] +/Rect [98.899 682.426 179.001 691.337] /Subtype /Link -/A << /S /GoTo /D (subsubsection.3.1.1) >> +/A << /S /GoTo /D (section.1) >> >> endobj 449 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 541.351 265.718 552.199] +/Rect [98.899 659.72 202.863 668.631] /Subtype /Link -/A << /S /GoTo /D (subsection.3.2) >> +/A << /S /GoTo /D (section.2) >> >> endobj 450 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] -/Rect [136.757 530.299 248.228 539.211] +/Rect [113.843 647.292 225.868 656.203] /Subtype /Link -/A << /S /GoTo /D (subsubsection.3.2.1) >> +/A << /S /GoTo /D (subsection.2.1) >> >> endobj 451 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 517.311 268.015 526.222] +/Rect [113.843 632.927 210.675 643.775] /Subtype /Link -/A << /S /GoTo /D (subsection.3.3) >> +/A << /S /GoTo /D (subsection.2.2) >> >> endobj 452 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 502.385 268.901 513.122] +/Rect [113.843 620.498 232.122 631.347] /Subtype /Link -/A << /S /GoTo /D (subsection.3.4) >> +/A << /S /GoTo /D (subsection.2.3) >> >> endobj 453 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] -/Rect [136.757 489.396 234.596 500.244] +/Rect [113.843 608.07 227.777 618.918] /Subtype /Link -/A << /S /GoTo /D (section*.2) >> +/A << /S /GoTo /D (subsection.2.4) >> >> endobj 454 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] -/Rect [136.757 476.407 230.971 487.255] +/Rect [98.899 587.301 196.34 596.129] /Subtype /Link -/A << /S /GoTo /D (section*.3) >> +/A << /S /GoTo /D (section.3) >> >> endobj 455 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] -/Rect [136.757 463.418 240.408 474.266] +/Rect [113.843 572.936 249.529 583.784] /Subtype /Link -/A << /S /GoTo /D (section*.4) >> +/A << /S /GoTo /D (subsection.3.1) >> >> endobj 456 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] -/Rect [136.757 450.429 236.782 461.277] +/Rect [136.757 562.445 248.228 571.356] /Subtype /Link -/A << /S /GoTo /D (section*.5) >> +/A << /S /GoTo /D (subsubsection.3.1.1) >> >> endobj 457 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] -/Rect [136.757 437.44 219.857 448.288] +/Rect [113.843 548.079 265.718 558.927] /Subtype /Link -/A << /S /GoTo /D (section*.6) >> +/A << /S /GoTo /D (subsection.3.2) >> >> endobj 458 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] -/Rect [136.757 424.451 252.889 435.299] +/Rect [136.757 537.588 248.228 546.499] /Subtype /Link -/A << /S /GoTo /D (section*.7) >> +/A << /S /GoTo /D (subsubsection.3.2.1) >> >> endobj 459 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] -/Rect [136.757 411.462 251.837 422.311] +/Rect [113.843 525.16 265.358 533.96] /Subtype /Link -/A << /S /GoTo /D (section*.8) >> +/A << /S /GoTo /D (subsection.3.3) >> >> endobj 460 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] -/Rect [136.757 398.473 215.844 409.322] +/Rect [136.757 512.732 248.228 521.643] /Subtype /Link -/A << /S /GoTo /D (section*.9) >> +/A << /S /GoTo /D (subsubsection.3.3.1) >> >> endobj 461 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] -/Rect [136.757 385.485 208.898 396.333] +/Rect [113.843 500.304 268.015 509.215] /Subtype /Link -/A << /S /GoTo /D (section*.10) >> +/A << /S /GoTo /D (subsection.3.4) >> >> endobj 462 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] -/Rect [136.757 372.496 219.995 383.344] +/Rect [113.843 485.938 268.901 496.676] /Subtype /Link -/A << /S /GoTo /D (section*.11) >> +/A << /S /GoTo /D (subsection.3.5) >> >> endobj 463 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] -/Rect [98.899 348.855 235.028 359.703] +/Rect [136.757 473.51 202.461 484.358] /Subtype /Link -/A << /S /GoTo /D (section.4) >> +/A << /S /GoTo /D (section*.2) >> >> endobj 464 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 335.866 170.121 346.714] +/Rect [136.757 461.082 198.836 471.93] /Subtype /Link -/A << /S /GoTo /D (section*.12) >> +/A << /S /GoTo /D (section*.3) >> >> endobj 465 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 322.877 158.221 333.725] +/Rect [136.757 448.654 208.273 459.502] /Subtype /Link -/A << /S /GoTo /D (section*.13) >> +/A << /S /GoTo /D (section*.4) >> >> endobj 466 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 309.888 162.151 320.737] +/Rect [136.757 436.225 204.647 447.074] /Subtype /Link -/A << /S /GoTo /D (section*.14) >> +/A << /S /GoTo /D (section*.5) >> >> endobj 467 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 296.899 167.354 307.748] +/Rect [136.757 423.797 187.722 434.147] /Subtype /Link -/A << /S /GoTo /D (section*.15) >> +/A << /S /GoTo /D (section*.6) >> >> endobj 468 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 283.911 171.283 294.759] +/Rect [136.757 411.369 252.889 422.217] /Subtype /Link -/A << /S /GoTo /D (section*.16) >> +/A << /S /GoTo /D (section*.7) >> >> endobj 469 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 270.922 166.579 281.77] +/Rect [136.757 398.941 251.837 409.789] /Subtype /Link -/A << /S /GoTo /D (section*.17) >> +/A << /S /GoTo /D (section*.8) >> >> endobj 470 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 257.933 170.508 268.781] +/Rect [136.757 386.512 180.886 396.863] /Subtype /Link -/A << /S /GoTo /D (section*.18) >> +/A << /S /GoTo /D (section*.9) >> >> endobj 471 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 244.944 170.508 255.792] +/Rect [136.757 374.084 177.261 384.932] /Subtype /Link -/A << /S /GoTo /D (section*.19) >> +/A << /S /GoTo /D (section*.10) >> >> endobj 472 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 231.955 170.481 242.803] +/Rect [136.757 361.656 188.358 372.006] /Subtype /Link -/A << /S /GoTo /D (section*.20) >> +/A << /S /GoTo /D (section*.11) >> >> endobj 473 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 218.966 164.393 229.814] +/Rect [98.899 338.95 235.028 349.798] /Subtype /Link -/A << /S /GoTo /D (section*.21) >> +/A << /S /GoTo /D (section.4) >> >> endobj 474 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 205.977 160.49 216.825] +/Rect [113.843 326.522 170.121 337.37] /Subtype /Link -/A << /S /GoTo /D (section*.22) >> +/A << /S /GoTo /D (section*.12) >> >> endobj 475 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 192.988 156.118 203.837] +/Rect [113.843 314.093 158.221 324.942] /Subtype /Link -/A << /S /GoTo /D (section*.23) >> +/A << /S /GoTo /D (section*.13) >> >> endobj 476 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] -/Rect [98.899 171.285 239.325 180.196] +/Rect [113.843 301.665 162.151 312.513] /Subtype /Link -/A << /S /GoTo /D (section.5) >> +/A << /S /GoTo /D (section*.14) >> >> endobj 477 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 156.359 152.686 167.207] +/Rect [113.843 289.237 167.354 300.085] /Subtype /Link -/A << /S /GoTo /D (section*.24) >> +/A << /S /GoTo /D (section*.15) >> >> endobj 478 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 143.37 151.054 154.218] +/Rect [113.843 276.809 171.283 287.657] /Subtype /Link -/A << /S /GoTo /D (section*.25) >> +/A << /S /GoTo /D (section*.16) >> >> endobj 479 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] -/Rect [113.843 130.381 162.123 141.229] +/Rect [113.843 264.381 166.579 275.229] +/Subtype /Link +/A << /S /GoTo /D (section*.17) >> +>> endobj +480 0 obj << +/Type /Annot +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [113.843 251.952 170.508 262.801] +/Subtype /Link +/A << /S /GoTo /D (section*.18) >> +>> endobj +481 0 obj << +/Type /Annot +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [113.843 239.524 170.508 250.372] +/Subtype /Link +/A << /S /GoTo /D (section*.19) >> +>> endobj +482 0 obj << +/Type /Annot +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [113.843 227.096 170.481 237.944] +/Subtype /Link +/A << /S /GoTo /D (section*.20) >> +>> endobj +483 0 obj << +/Type /Annot +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [113.843 214.668 164.393 225.516] +/Subtype /Link +/A << /S /GoTo /D (section*.21) >> +>> endobj +484 0 obj << +/Type /Annot +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [113.843 202.239 160.49 213.088] +/Subtype /Link +/A << /S /GoTo /D (section*.22) >> +>> endobj +485 0 obj << +/Type /Annot +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [113.843 189.811 156.118 200.659] +/Subtype /Link +/A << /S /GoTo /D (section*.23) >> +>> endobj +486 0 obj << +/Type /Annot +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [98.899 169.042 239.325 177.953] +/Subtype /Link +/A << /S /GoTo /D (section.5) >> +>> endobj +487 0 obj << +/Type /Annot +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [113.843 154.677 152.686 165.525] +/Subtype /Link +/A << /S /GoTo /D (section*.24) >> +>> endobj +488 0 obj << +/Type /Annot +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [113.843 142.249 151.054 153.097] +/Subtype /Link +/A << /S /GoTo /D (section*.25) >> +>> endobj +489 0 obj << +/Type /Annot +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [113.843 129.82 162.123 140.669] /Subtype /Link /A << /S /GoTo /D (section*.26) >> >> endobj -480 0 obj << +490 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [113.843 117.392 163.839 128.24] /Subtype /Link /A << /S /GoTo /D (section*.27) >> >> endobj -487 0 obj << -/D [485 0 R /XYZ 99.895 740.998 null] +495 0 obj << +/D [493 0 R /XYZ 99.895 740.998 null] >> endobj -488 0 obj << -/D [485 0 R /XYZ 99.895 695.521 null] +496 0 obj << +/D [493 0 R /XYZ 99.895 695.924 null] >> endobj -484 0 obj << -/Font << /F16 431 0 R /F27 433 0 R /F8 434 0 R >> +492 0 obj << +/Font << /F16 439 0 R /F27 441 0 R /F8 442 0 R >> /ProcSet [ /PDF /Text ] >> endobj -537 0 obj << +547 0 obj << /Length 20922 >> stream @@ -1671,7 +1599,7 @@ stream BT /F27 9.9626 Tf 150.705 706.129 Td [(6)-925(Data)-383(managem)-1(e)1(n)31(t)-383(routines)]TJ 0 g 0 G - [-18205(52)]TJ + [-18205(54)]TJ 0 0 1 rg 0 0 1 RG /F8 9.9626 Tf 14.944 -13.071 Td [(psb)]TJ ET @@ -1684,7 +1612,7 @@ BT 0 g 0 G [-273(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-1084(52)]TJ + [-1084(54)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -18.586 -13.07 Td [(psb)]TJ @@ -1698,7 +1626,7 @@ BT 0 g 0 G [-879(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-1084(56)]TJ + [-1084(58)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -18.586 -13.07 Td [(psb)]TJ @@ -1712,7 +1640,7 @@ BT 0 g 0 G [-657(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-1083(57)]TJ + [-1083(59)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -18.586 -13.071 Td [(psb)]TJ @@ -1726,7 +1654,7 @@ BT 0 g 0 G [-607(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-1084(58)]TJ + [-1084(60)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -18.586 -13.07 Td [(psb)]TJ @@ -1740,7 +1668,7 @@ BT 0 g 0 G [-520(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)]TJ 0 g 0 G - [-1084(59)]TJ + [-1084(61)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -18.586 -13.07 Td [(psb)]TJ @@ -1754,7 +1682,7 @@ BT 0 g 0 G [-912(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-1084(60)]TJ + [-1084(62)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -18.586 -13.071 Td [(psb)]TJ @@ -1768,7 +1696,7 @@ BT 0 g 0 G [-323(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-1084(62)]TJ + [-1084(64)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -18.586 -13.07 Td [(psb)]TJ @@ -1782,7 +1710,7 @@ BT 0 g 0 G [-929(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-1084(63)]TJ + [-1084(65)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -18.586 -13.071 Td [(psb)]TJ @@ -1796,7 +1724,7 @@ BT 0 g 0 G [-707(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-1083(65)]TJ + [-1083(67)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -18.586 -13.07 Td [(psb)]TJ @@ -1810,7 +1738,7 @@ BT 0 g 0 G [-570(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)]TJ 0 g 0 G - [-1084(67)]TJ + [-1084(69)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -18.586 -13.07 Td [(psb)]TJ @@ -1824,7 +1752,7 @@ BT 0 g 0 G [-431(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)]TJ 0 g 0 G - [-1084(68)]TJ + [-1084(70)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -18.586 -13.071 Td [(psb)]TJ @@ -1838,7 +1766,7 @@ BT 0 g 0 G [-329(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-1084(69)]TJ + [-1084(71)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -18.586 -13.07 Td [(psb)]TJ @@ -1852,7 +1780,7 @@ BT 0 g 0 G [-934(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-1084(70)]TJ + [-1084(72)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -18.586 -13.071 Td [(psb)]TJ @@ -1866,7 +1794,7 @@ BT 0 g 0 G [-712(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-1084(72)]TJ + [-1084(74)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -18.586 -13.07 Td [(psb)]TJ @@ -1880,7 +1808,7 @@ BT 0 g 0 G [-576(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-1084(73)]TJ + [-1084(75)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -18.586 -13.07 Td [(psb)]TJ @@ -1894,7 +1822,7 @@ BT 0 g 0 G [-551(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-1084(74)]TJ + [-1084(76)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -18.586 -13.071 Td [(psb)]TJ @@ -1922,7 +1850,7 @@ BT 0 g 0 G [-747(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-1083(75)]TJ + [-1083(77)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -52.879 -13.07 Td [(psb)]TJ @@ -1950,7 +1878,7 @@ BT 0 g 0 G [-748(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-1083(77)]TJ + [-1083(79)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -47.068 -13.071 Td [(psb)]TJ @@ -1971,7 +1899,7 @@ BT 0 g 0 G [-880(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-1084(78)]TJ + [-1084(80)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -28.869 -13.07 Td [(psb)]TJ @@ -1992,7 +1920,7 @@ BT 0 g 0 G [-746(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-1083(79)]TJ + [-1083(81)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -49.57 -13.07 Td [(psb)]TJ @@ -2013,7 +1941,7 @@ BT 0 g 0 G [-824(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-1084(80)]TJ + [-1084(82)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -28.869 -13.071 Td [(psb)]TJ @@ -2034,7 +1962,7 @@ BT 0 g 0 G [-691(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-1084(81)]TJ + [-1084(83)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -42.374 -13.07 Td [(psb)]TJ @@ -2055,7 +1983,7 @@ BT 0 g 0 G [-354(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-1083(82)]TJ + [-1083(84)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -35.456 -13.07 Td [(psb)]TJ @@ -2076,7 +2004,7 @@ BT 0 g 0 G [-605(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-1084(83)]TJ + [-1084(85)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -35.456 -13.071 Td [(psb)]TJ @@ -2097,7 +2025,7 @@ BT 0 g 0 G [-433(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-1084(84)]TJ + [-1084(86)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -31.637 -13.07 Td [(psb)]TJ @@ -2111,19 +2039,19 @@ BT 0 g 0 G [-740(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-1084(86)]TJ + [-1084(88)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -18.586 -13.071 Td [(Sorting)-333(utilities)]TJ 0 g 0 G [-519(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-1083(87)]TJ + [-1083(89)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG /F27 9.9626 Tf -14.944 -23.776 Td [(7)-925(P)32(arallel)-384(en)32(vironmen)32(t)-383(routines)]TJ 0 g 0 G - [-16891(89)]TJ + [-16891(91)]TJ 0 0 1 rg 0 0 1 RG /F8 9.9626 Tf 14.944 -13.071 Td [(psb)]TJ ET @@ -2136,7 +2064,7 @@ BT 0 g 0 G [-829(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-1083(90)]TJ + [-1083(92)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -18.586 -13.07 Td [(psb)]TJ @@ -2150,7 +2078,7 @@ BT 0 g 0 G [-690(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-1084(91)]TJ + [-1084(93)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -18.586 -13.07 Td [(psb)]TJ @@ -2164,7 +2092,7 @@ BT 0 g 0 G [-690(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-1084(92)]TJ + [-1084(94)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -18.586 -13.071 Td [(psb)]TJ @@ -2185,7 +2113,7 @@ BT 0 g 0 G [-1024(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-1083(93)]TJ + [-1083(95)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -35.456 -13.07 Td [(psb)]TJ @@ -2206,7 +2134,7 @@ BT 0 g 0 G [-994(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-1083(94)]TJ + [-1083(96)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -35.456 -13.07 Td [(psb)]TJ @@ -2220,7 +2148,7 @@ BT 0 g 0 G [-440(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-1084(95)]TJ + [-1084(97)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -18.586 -13.071 Td [(psb)]TJ @@ -2234,7 +2162,7 @@ BT 0 g 0 G [-931(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)]TJ 0 g 0 G - [-1084(96)]TJ + [-1084(98)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -18.586 -13.07 Td [(psb)]TJ @@ -2248,7 +2176,7 @@ BT 0 g 0 G [-742(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-1084(97)]TJ + [-1084(99)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -18.586 -13.071 Td [(psb)]TJ @@ -2262,7 +2190,7 @@ BT 0 g 0 G [-795(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-1084(98)]TJ + [-584(100)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -18.586 -13.07 Td [(psb)]TJ @@ -2276,7 +2204,7 @@ BT 0 g 0 G [-545(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)]TJ 0 g 0 G - [-1084(99)]TJ + [-584(101)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -18.586 -13.07 Td [(psb)]TJ @@ -2290,7 +2218,7 @@ BT 0 g 0 G [-468(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-583(100)]TJ + [-583(102)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -18.586 -13.071 Td [(psb)]TJ @@ -2304,7 +2232,7 @@ BT 0 g 0 G [-662(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-584(101)]TJ + [-584(103)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -18.586 -13.07 Td [(psb)]TJ @@ -2318,7 +2246,7 @@ BT 0 g 0 G [-468(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-583(102)]TJ + [-583(104)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -18.586 -13.071 Td [(psb)]TJ @@ -2332,7 +2260,7 @@ BT 0 g 0 G [-440(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-584(103)]TJ + [-584(105)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -18.586 -13.07 Td [(psb)]TJ @@ -2346,7 +2274,7 @@ BT 0 g 0 G [-823(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-584(104)]TJ + [-584(106)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -18.586 -13.07 Td [(psb)]TJ @@ -2360,7 +2288,7 @@ BT 0 g 0 G [-965(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-584(105)]TJ + [-584(107)]TJ 0 g 0 G 0 g 0 G 135.558 -29.888 Td [(ii)]TJ @@ -2368,337 +2296,337 @@ BT ET endstream endobj -536 0 obj << +546 0 obj << /Type /Page -/Contents 537 0 R -/Resources 535 0 R +/Contents 547 0 R +/Resources 545 0 R /MediaBox [0 0 595.276 841.89] -/Parent 435 0 R -/Annots [ 481 0 R 482 0 R 483 0 R 489 0 R 490 0 R 491 0 R 492 0 R 493 0 R 494 0 R 495 0 R 496 0 R 497 0 R 498 0 R 499 0 R 500 0 R 501 0 R 502 0 R 503 0 R 504 0 R 505 0 R 506 0 R 507 0 R 508 0 R 509 0 R 510 0 R 511 0 R 512 0 R 513 0 R 514 0 R 515 0 R 516 0 R 517 0 R 518 0 R 519 0 R 520 0 R 521 0 R 522 0 R 523 0 R 524 0 R 525 0 R 526 0 R 527 0 R 528 0 R 529 0 R 530 0 R ] +/Parent 443 0 R +/Annots [ 491 0 R 497 0 R 498 0 R 499 0 R 500 0 R 501 0 R 502 0 R 503 0 R 504 0 R 505 0 R 506 0 R 507 0 R 508 0 R 509 0 R 510 0 R 511 0 R 512 0 R 513 0 R 514 0 R 515 0 R 516 0 R 517 0 R 518 0 R 519 0 R 520 0 R 521 0 R 522 0 R 523 0 R 524 0 R 525 0 R 526 0 R 527 0 R 528 0 R 529 0 R 530 0 R 531 0 R 532 0 R 533 0 R 534 0 R 535 0 R 536 0 R 537 0 R 538 0 R 539 0 R 540 0 R ] >> endobj -481 0 obj << +491 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [149.709 703.195 302.58 714.044] /Subtype /Link /A << /S /GoTo /D (section.6) >> >> endobj -482 0 obj << +497 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 690.125 205.71 700.973] /Subtype /Link /A << /S /GoTo /D (section*.28) >> >> endobj -483 0 obj << +498 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 677.055 207.426 687.903] /Subtype /Link /A << /S /GoTo /D (section*.29) >> >> endobj -489 0 obj << +499 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 663.984 209.639 674.832] /Subtype /Link /A << /S /GoTo /D (section*.30) >> >> endobj -490 0 obj << +500 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 650.914 210.138 661.762] /Subtype /Link /A << /S /GoTo /D (section*.31) >> >> endobj -491 0 obj << +501 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 637.843 210.996 648.692] /Subtype /Link /A << /S /GoTo /D (section*.32) >> >> endobj -492 0 obj << +502 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 624.773 222.591 635.621] /Subtype /Link /A << /S /GoTo /D (section*.33) >> >> endobj -493 0 obj << +503 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 611.703 205.212 622.551] /Subtype /Link /A << /S /GoTo /D (section*.34) >> >> endobj -494 0 obj << +504 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 598.632 206.927 609.481] /Subtype /Link /A << /S /GoTo /D (section*.35) >> >> endobj -495 0 obj << +505 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 585.562 209.141 596.41] /Subtype /Link /A << /S /GoTo /D (section*.36) >> >> endobj -496 0 obj << +506 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 572.492 210.497 583.34] /Subtype /Link /A << /S /GoTo /D (section*.37) >> >> endobj -497 0 obj << +507 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 559.421 204.132 570.269] /Subtype /Link /A << /S /GoTo /D (section*.38) >> >> endobj -498 0 obj << +508 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 546.351 205.156 557.199] /Subtype /Link /A << /S /GoTo /D (section*.39) >> >> endobj -499 0 obj << +509 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 533.28 206.872 544.129] /Subtype /Link /A << /S /GoTo /D (section*.40) >> >> endobj -500 0 obj << +510 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 520.21 209.086 531.058] /Subtype /Link /A << /S /GoTo /D (section*.41) >> >> endobj -501 0 obj << +511 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 507.14 210.442 517.988] /Subtype /Link /A << /S /GoTo /D (section*.42) >> >> endobj -502 0 obj << +512 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 494.069 202.942 504.917] /Subtype /Link /A << /S /GoTo /D (section*.43) >> >> endobj -503 0 obj << +513 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 480.999 231.978 491.847] /Subtype /Link /A << /S /GoTo /D (section*.44) >> >> endobj -504 0 obj << +514 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 467.928 231.978 478.777] /Subtype /Link /A << /S /GoTo /D (section*.45) >> >> endobj -505 0 obj << +515 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 454.858 222.912 465.706] /Subtype /Link /A << /S /GoTo /D (section*.46) >> >> endobj -506 0 obj << +516 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 441.788 239.738 452.636] /Subtype /Link /A << /S /GoTo /D (section*.47) >> >> endobj -507 0 obj << +517 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 428.717 215.717 439.565] /Subtype /Link /A << /S /GoTo /D (section*.48) >> >> endobj -508 0 obj << +518 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 415.647 232.543 426.495] /Subtype /Link /A << /S /GoTo /D (section*.49) >> >> endobj -509 0 obj << +519 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 402.576 243.64 413.425] /Subtype /Link /A << /S /GoTo /D (section*.50) >> >> endobj -510 0 obj << +520 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 389.506 233.4 400.354] /Subtype /Link /A << /S /GoTo /D (section*.51) >> >> endobj -511 0 obj << +521 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 376.436 227.367 387.284] /Subtype /Link /A << /S /GoTo /D (section*.52) >> >> endobj -512 0 obj << +522 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 363.365 208.809 374.214] /Subtype /Link /A << /S /GoTo /D (section*.53) >> >> endobj -513 0 obj << +523 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 350.295 234.253 361.143] /Subtype /Link /A << /S /GoTo /D (section*.54) >> >> endobj -514 0 obj << +524 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [149.709 328.456 315.677 337.367] /Subtype /Link /A << /S /GoTo /D (section.7) >> >> endobj -515 0 obj << +525 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 313.448 200.175 324.296] /Subtype /Link /A << /S /GoTo /D (section*.55) >> >> endobj -516 0 obj << +526 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 300.378 201.559 311.226] /Subtype /Link /A << /S /GoTo /D (section*.56) >> >> endobj -517 0 obj << +527 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 287.307 201.559 298.155] /Subtype /Link /A << /S /GoTo /D (section*.57) >> >> endobj -518 0 obj << +528 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 274.237 244.719 285.085] /Subtype /Link /A << /S /GoTo /D (section*.58) >> >> endobj -519 0 obj << +529 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 261.166 221.777 272.015] /Subtype /Link /A << /S /GoTo /D (section*.59) >> >> endobj -520 0 obj << +530 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 248.096 211.798 258.944] /Subtype /Link /A << /S /GoTo /D (section*.60) >> >> endobj -521 0 obj << +531 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 235.026 214.648 245.874] /Subtype /Link /A << /S /GoTo /D (section*.61) >> >> endobj -522 0 obj << +532 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 221.955 208.782 232.804] /Subtype /Link /A << /S /GoTo /D (section*.62) >> >> endobj -523 0 obj << +533 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 208.885 208.256 219.733] /Subtype /Link /A << /S /GoTo /D (section*.63) >> >> endobj -524 0 obj << +534 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 195.815 202.998 206.663] /Subtype /Link /A << /S /GoTo /D (section*.64) >> >> endobj -525 0 obj << +535 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 182.744 203.773 193.592] /Subtype /Link /A << /S /GoTo /D (section*.65) >> >> endobj -526 0 obj << +536 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 169.674 201.835 180.522] /Subtype /Link /A << /S /GoTo /D (section*.66) >> >> endobj -527 0 obj << +537 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 156.603 203.773 167.452] /Subtype /Link /A << /S /GoTo /D (section*.67) >> >> endobj -528 0 obj << +538 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 143.533 204.049 154.381] /Subtype /Link /A << /S /GoTo /D (section*.68) >> >> endobj -529 0 obj << +539 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 130.463 200.23 141.311] /Subtype /Link /A << /S /GoTo /D (section*.69) >> >> endobj -530 0 obj << +540 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [164.653 117.392 198.819 128.24] /Subtype /Link /A << /S /GoTo /D (section*.70) >> >> endobj -538 0 obj << -/D [536 0 R /XYZ 150.705 740.998 null] +548 0 obj << +/D [546 0 R /XYZ 150.705 740.998 null] >> endobj -535 0 obj << -/Font << /F27 433 0 R /F8 434 0 R >> +545 0 obj << +/Font << /F27 441 0 R /F8 442 0 R >> /ProcSet [ /PDF /Text ] >> endobj -555 0 obj << +565 0 obj << /Length 7118 >> stream @@ -2708,7 +2636,7 @@ stream BT /F27 9.9626 Tf 99.895 706.129 Td [(8)-925(Error)-383(handling)]TJ 0 g 0 G - [-23812(106)]TJ + [-23812(108)]TJ 0 0 1 rg 0 0 1 RG /F8 9.9626 Tf 14.944 -11.955 Td [(psb)]TJ ET @@ -2721,7 +2649,7 @@ BT 0 g 0 G [-595(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-584(108)]TJ + [-584(110)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -18.586 -11.955 Td [(psb)]TJ @@ -2735,7 +2663,7 @@ BT 0 g 0 G [-987(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-584(109)]TJ + [-584(111)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -18.586 -11.956 Td [(psb)]TJ @@ -2756,7 +2684,7 @@ BT 0 g 0 G [-977(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-584(110)]TJ + [-584(112)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -34.405 -11.955 Td [(psb)]TJ @@ -2777,12 +2705,12 @@ BT 0 g 0 G [-735(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)]TJ 0 g 0 G - [-584(111)]TJ + [-584(113)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG /F27 9.9626 Tf -49.349 -21.918 Td [(9)-925(Utilities)]TJ 0 g 0 G - [-27238(112)]TJ + [-27238(114)]TJ 0 0 1 rg 0 0 1 RG /F8 9.9626 Tf 37.859 -11.955 Td [(h)28(b)]TJ ET @@ -2795,7 +2723,7 @@ BT 0 g 0 G [-893(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-583(113)]TJ + [-583(115)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -14.38 -11.955 Td [(h)28(b)]TJ @@ -2809,7 +2737,7 @@ BT 0 g 0 G [-559(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-584(114)]TJ + [-584(116)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -14.38 -11.955 Td [(mm)]TJ @@ -2830,7 +2758,7 @@ BT 0 g 0 G [-560(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-583(115)]TJ + [-583(117)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -40.935 -11.955 Td [(mm)]TJ @@ -2851,7 +2779,7 @@ BT 0 g 0 G [-949(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-584(116)]TJ + [-584(118)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -37.062 -11.955 Td [(mm)]TJ @@ -2872,12 +2800,12 @@ BT 0 g 0 G [-1005(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-584(117)]TJ + [-584(119)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG /F27 9.9626 Tf -78.794 -21.918 Td [(10)-350(Preconditioner)-383(routi)-1(ne)1(s)]TJ 0 g 0 G - [-19367(118)]TJ + [-19367(120)]TJ 0 0 1 rg 0 0 1 RG /F8 9.9626 Tf 14.944 -11.955 Td [(psb)]TJ ET @@ -2890,7 +2818,7 @@ BT 0 g 0 G [-548(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-584(119)]TJ + [-584(121)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -18.586 -11.956 Td [(psb)]TJ @@ -2904,7 +2832,7 @@ BT 0 g 0 G [-659(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-584(120)]TJ + [-584(122)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -18.586 -11.955 Td [(psb)]TJ @@ -2918,7 +2846,7 @@ BT 0 g 0 G [-965(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-584(121)]TJ + [-584(123)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG -18.586 -11.955 Td [(psb)]TJ @@ -2932,18 +2860,18 @@ BT 0 g 0 G [-596(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-583(122)]TJ + [-583(124)]TJ 0 g 0 G 0 0 1 rg 0 0 1 RG /F27 9.9626 Tf -33.53 -21.918 Td [(11)-350(Iterativ)32(e)-384(Metho)-31(ds)]TJ 0 g 0 G - [-22176(123)]TJ + [-22176(125)]TJ 0 0 1 rg 0 0 1 RG /F8 9.9626 Tf 14.944 -11.955 Td [(krylo)28(v)]TJ 0 g 0 G [-692(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-499(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)-500(.)]TJ 0 g 0 G - [-583(124)]TJ + [-583(126)]TJ 0 g 0 G 0 g 0 G 152.761 -382.565 Td [(iii)]TJ @@ -2951,148 +2879,148 @@ BT ET endstream endobj -554 0 obj << +564 0 obj << /Type /Page -/Contents 555 0 R -/Resources 553 0 R +/Contents 565 0 R +/Resources 563 0 R /MediaBox [0 0 595.276 841.89] -/Parent 435 0 R -/Annots [ 531 0 R 532 0 R 533 0 R 534 0 R 539 0 R 540 0 R 541 0 R 542 0 R 543 0 R 544 0 R 545 0 R 546 0 R 547 0 R 548 0 R 549 0 R 550 0 R 551 0 R 552 0 R ] +/Parent 443 0 R +/Annots [ 541 0 R 542 0 R 543 0 R 544 0 R 549 0 R 550 0 R 551 0 R 552 0 R 553 0 R 554 0 R 555 0 R 556 0 R 557 0 R 558 0 R 559 0 R 560 0 R 561 0 R 562 0 R ] >> endobj -531 0 obj << +541 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [98.899 703.195 190.188 714.044] /Subtype /Link /A << /S /GoTo /D (section.8) >> >> endobj -532 0 obj << +542 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [113.843 691.24 167.188 702.088] /Subtype /Link /A << /S /GoTo /D (section*.71) >> >> endobj -533 0 obj << +543 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [113.843 679.285 155.537 690.133] /Subtype /Link /A << /S /GoTo /D (section*.72) >> >> endobj -534 0 obj << +544 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [113.843 667.33 202.129 678.178] /Subtype /Link /A << /S /GoTo /D (section*.73) >> >> endobj -539 0 obj << +549 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [113.843 655.375 189.039 666.223] /Subtype /Link /A << /S /GoTo /D (section*.74) >> >> endobj -540 0 obj << +550 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [98.899 635.394 156.061 644.305] /Subtype /Link /A << /S /GoTo /D (section.9) >> >> endobj -541 0 obj << +551 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [136.757 623.439 171.975 632.35] /Subtype /Link /A << /S /GoTo /D (section*.75) >> >> endobj -542 0 obj << +552 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [136.757 611.484 175.296 620.395] /Subtype /Link /A << /S /GoTo /D (section*.76) >> >> endobj -543 0 obj << +553 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [136.757 599.529 198.531 608.44] /Subtype /Link /A << /S /GoTo /D (section*.77) >> >> endobj -544 0 obj << +554 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [136.757 587.573 197.978 596.484] /Subtype /Link /A << /S /GoTo /D (section*.78) >> >> endobj -545 0 obj << +555 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [136.757 575.618 201.852 584.264] /Subtype /Link /A << /S /GoTo /D (section*.79) >> >> endobj -546 0 obj << +556 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [98.899 553.7 234.475 562.611] /Subtype /Link /A << /S /GoTo /D (section.10) >> >> endobj -547 0 obj << +557 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [113.843 539.808 167.658 550.656] /Subtype /Link /A << /S /GoTo /D (section*.80) >> >> endobj -548 0 obj << +558 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [113.843 527.853 166.551 538.701] /Subtype /Link /A << /S /GoTo /D (section*.81) >> >> endobj -549 0 obj << +559 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [113.843 515.898 171.256 526.746] /Subtype /Link /A << /S /GoTo /D (section*.82) >> >> endobj -550 0 obj << +560 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [113.843 503.943 174.936 514.791] /Subtype /Link /A << /S /GoTo /D (section*.83) >> >> endobj -551 0 obj << +561 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [98.899 483.962 206.49 492.873] /Subtype /Link /A << /S /GoTo /D (section.11) >> >> endobj -552 0 obj << +562 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [113.843 470.07 142.984 480.918] /Subtype /Link /A << /S /GoTo /D (section*.84) >> >> endobj -556 0 obj << -/D [554 0 R /XYZ 99.895 740.998 null] +566 0 obj << +/D [564 0 R /XYZ 99.895 740.998 null] >> endobj -553 0 obj << -/Font << /F27 433 0 R /F8 434 0 R >> +563 0 obj << +/Font << /F27 441 0 R /F8 442 0 R >> /ProcSet [ /PDF /Text ] >> endobj -559 0 obj << +569 0 obj << /Length 79 >> stream @@ -3105,21 +3033,21 @@ BT ET endstream endobj -558 0 obj << +568 0 obj << /Type /Page -/Contents 559 0 R -/Resources 557 0 R +/Contents 569 0 R +/Resources 567 0 R /MediaBox [0 0 595.276 841.89] -/Parent 435 0 R +/Parent 443 0 R >> endobj -560 0 obj << -/D [558 0 R /XYZ 150.705 740.998 null] +570 0 obj << +/D [568 0 R /XYZ 150.705 740.998 null] >> endobj -557 0 obj << -/Font << /F8 434 0 R >> +567 0 obj << +/Font << /F8 442 0 R >> /ProcSet [ /PDF /Text ] >> endobj -572 0 obj << +582 0 obj << /Length 8080 >> stream @@ -3161,57 +3089,57 @@ BT ET endstream endobj -571 0 obj << +581 0 obj << /Type /Page -/Contents 572 0 R -/Resources 570 0 R +/Contents 582 0 R +/Resources 580 0 R /MediaBox [0 0 595.276 841.89] -/Parent 574 0 R -/Annots [ 561 0 R 562 0 R 563 0 R 564 0 R 565 0 R 566 0 R 567 0 R ] +/Parent 584 0 R +/Annots [ 571 0 R 572 0 R 573 0 R 574 0 R 575 0 R 576 0 R 577 0 R ] >> endobj -561 0 obj << +571 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[0 1 0] /Rect [408.337 572.368 420.292 580.781] /Subtype /Link /A << /S /GoTo /D (cite.metcalf) >> >> endobj -562 0 obj << +572 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[0 1 0] /Rect [223.601 536.502 235.556 544.915] /Subtype /Link /A << /S /GoTo /D (cite.machiels) >> >> endobj -563 0 obj << +573 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[0 1 0] /Rect [132.506 404.995 139.48 413.408] /Subtype /Link /A << /S /GoTo /D (cite.sblas97) >> >> endobj -564 0 obj << +574 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[0 1 0] /Rect [144.805 404.995 151.778 413.408] /Subtype /Link /A << /S /GoTo /D (cite.sblas02) >> >> endobj -565 0 obj << +575 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[0 1 0] /Rect [141.6 393.04 153.555 401.453] /Subtype /Link /A << /S /GoTo /D (cite.BLAS1) >> >> endobj -566 0 obj << +576 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[0 1 0] /Rect [157.651 393.04 164.625 401.453] /Subtype /Link /A << /S /GoTo /D (cite.BLAS2) >> >> endobj -567 0 obj << +577 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[0 1 0] /Rect [168.721 393.04 175.695 401.453] @@ -3219,13 +3147,13 @@ endobj /A << /S /GoTo /D (cite.BLAS3) >> >> endobj 10 0 obj << -/D [571 0 R /XYZ 99.895 716.092 null] +/D [581 0 R /XYZ 99.895 716.092 null] >> endobj -570 0 obj << -/Font << /F16 431 0 R /F8 434 0 R /F17 573 0 R >> +580 0 obj << +/Font << /F16 439 0 R /F8 442 0 R /F17 583 0 R >> /ProcSet [ /PDF /Text ] >> endobj -586 0 obj << +596 0 obj << /Length 5446 >> stream @@ -3273,29 +3201,29 @@ BT ET endstream endobj -585 0 obj << +595 0 obj << /Type /Page -/Contents 586 0 R -/Resources 584 0 R +/Contents 596 0 R +/Resources 594 0 R /MediaBox [0 0 595.276 841.89] -/Parent 574 0 R -/Annots [ 568 0 R 569 0 R 582 0 R ] +/Parent 584 0 R +/Annots [ 578 0 R 579 0 R 592 0 R ] >> endobj -583 0 obj << +593 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./figures/psblas.pdf) /PTEX.PageNumber 1 -/PTEX.InfoDict 589 0 R +/PTEX.InfoDict 599 0 R /BBox [0 0 283 264] /Resources << /ProcSet [ /PDF /Text ] /ExtGState << -/R7 590 0 R ->>/Font << /R8 591 0 R>> +/R7 600 0 R +>>/Font << /R8 601 0 R>> >> -/Length 592 0 R +/Length 602 0 R /Filter /FlateDecode >> stream @@ -3305,44 +3233,44 @@ z 7ï“Ü$¼}ñð-¯Ìë-¿3%+`fy Ž &Nà‘Ó^¡?m«y}šnºýýp¹ìoòz¹Ü�nYã+$Ía¡Ê0«ÞõÕxʾkzÔ endstream endobj -589 0 obj +599 0 obj << /Producer (ESP Ghostscript 815.04) /CreationDate (D:20071019142653) /ModDate (D:20071019142653) >> endobj -590 0 obj +600 0 obj << /Type /ExtGState /OPM 1 >> endobj -591 0 obj +601 0 obj << /BaseFont /Times-Roman /Type /Font /Subtype /Type1 >> endobj -592 0 obj +602 0 obj 1086 endobj -568 0 obj << +578 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [327.131 584.768 334.105 595.616] /Subtype /Link /A << /S /GoTo /D (figure.1) >> >> endobj -569 0 obj << +579 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[0 1 0] /Rect [284.655 514.974 291.629 523.387] /Subtype /Link /A << /S /GoTo /D (cite.BLACS) >> >> endobj -582 0 obj << +592 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [387.982 440.234 394.956 452.189] @@ -3350,17 +3278,17 @@ endobj /A << /S /GoTo /D (section.7) >> >> endobj 14 0 obj << -/D [585 0 R /XYZ 150.705 716.092 null] +/D [595 0 R /XYZ 150.705 716.092 null] >> endobj -588 0 obj << -/D [585 0 R /XYZ 258.703 228.406 null] +598 0 obj << +/D [595 0 R /XYZ 258.703 228.406 null] >> endobj -584 0 obj << -/Font << /F16 431 0 R /F8 434 0 R /F11 587 0 R >> -/XObject << /Im1 583 0 R >> +594 0 obj << +/Font << /F16 439 0 R /F8 442 0 R /F11 597 0 R >> +/XObject << /Im1 593 0 R >> /ProcSet [ /PDF /Text ] >> endobj -599 0 obj << +609 0 obj << /Length 9247 >> stream @@ -3407,52 +3335,52 @@ BT ET endstream endobj -598 0 obj << +608 0 obj << /Type /Page -/Contents 599 0 R -/Resources 597 0 R +/Contents 609 0 R +/Resources 607 0 R /MediaBox [0 0 595.276 841.89] -/Parent 574 0 R -/Annots [ 594 0 R 595 0 R 596 0 R ] +/Parent 584 0 R +/Annots [ 604 0 R 605 0 R 606 0 R ] >> endobj -594 0 obj << +604 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[0 1 0] /Rect [277.931 573.626 289.886 582.039] /Subtype /Link /A << /S /GoTo /D (cite.METIS) >> >> endobj -595 0 obj << +605 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [214.626 499.958 221.088 511.997] /Subtype /Link /A << /S /GoTo /D (Hfootnote.1) >> >> endobj -596 0 obj << +606 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [155.908 171.735 162.37 183.774] /Subtype /Link /A << /S /GoTo /D (Hfootnote.2) >> >> endobj -600 0 obj << -/D [598 0 R /XYZ 99.895 740.998 null] +610 0 obj << +/D [608 0 R /XYZ 99.895 740.998 null] >> endobj 18 0 obj << -/D [598 0 R /XYZ 99.895 475.542 null] +/D [608 0 R /XYZ 99.895 475.542 null] >> endobj -606 0 obj << -/D [598 0 R /XYZ 115.138 167.688 null] +616 0 obj << +/D [608 0 R /XYZ 115.138 167.688 null] >> endobj -608 0 obj << -/D [598 0 R /XYZ 115.138 158.184 null] +618 0 obj << +/D [608 0 R /XYZ 115.138 158.184 null] >> endobj -597 0 obj << -/Font << /F8 434 0 R /F17 573 0 R /F30 601 0 R /F7 602 0 R /F16 431 0 R /F11 587 0 R /F10 603 0 R /F14 604 0 R /F27 433 0 R /F32 605 0 R /F31 607 0 R >> +607 0 obj << +/Font << /F8 442 0 R /F17 583 0 R /F30 611 0 R /F7 612 0 R /F16 439 0 R /F11 597 0 R /F10 613 0 R /F14 614 0 R /F27 441 0 R /F32 615 0 R /F31 617 0 R >> /ProcSet [ /PDF /Text ] >> endobj -615 0 obj << +625 0 obj << /Length 5256 >> stream @@ -3524,29 +3452,29 @@ BT ET endstream endobj -614 0 obj << +624 0 obj << /Type /Page -/Contents 615 0 R -/Resources 613 0 R +/Contents 625 0 R +/Resources 623 0 R /MediaBox [0 0 595.276 841.89] -/Parent 574 0 R -/Annots [ 610 0 R 611 0 R ] +/Parent 584 0 R +/Annots [ 620 0 R 621 0 R ] >> endobj -612 0 obj << +622 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./figures/points.pdf) /PTEX.PageNumber 1 -/PTEX.InfoDict 618 0 R +/PTEX.InfoDict 628 0 R /BBox [0 0 274 308] /Resources << /ProcSet [ /PDF /Text ] /ExtGState << -/R7 619 0 R ->>/Font << /R8 620 0 R>> +/R7 629 0 R +>>/Font << /R8 630 0 R>> >> -/Length 621 0 R +/Length 631 0 R /Filter /FlateDecode >> stream @@ -3554,58 +3482,58 @@ x – ó£�„ ¹3ÊBü=®§«æ±bA‡HŒ�}Ï©c·í²»?­é”ׄÿäïÍeùö]_?ü¾¤Ó©d êwßGüðaù´d"®òçæ²¾¾ä}ÍíëÕûe4­ß ,äýÔ×sÿ»º,_ýx÷Ç/w×·¯®~[¾»ZÞ.ø›Œ1¸ð™âuóâ¯ïÿ¼ûùúáoO*žþ�x/þÃõí½Î22Tø<ᜇd†&Âoî/×ïV˜âÿõèCê1V^õd¨æõãR ¬Û9ŸÎç¶^–ºµÓ¾ÍšÚýÝz¦zõ¯7‹!€S®ûjì§”êJÚR¿–ðWZSöN•m˜´ ide«3çûfyÿõROÛú×|J_F¿~]~z2ò–}×òVÐ�Õämë¦Î€sQ<I<³¦uiüd¸r͵9.Ö¤¢ÆR’É�ÑãY~ОÐCÑÝ¥Ÿ}öçÙ^â<3LA ‰c‹YÒ¶®ôçY¯qž&mCÙØâÌû懣ç—Ñ#|H–_rƧšÇÒ³,wš0s>�}yüÇ5ÒNó�Ë p%U¤ –ðW@E’§$§•|¡pxõE�`&ÆøåU ™¤ó«›%AÝIUÍ0Gš�]ý‘&ûÖM’ î Jšx÷¬…T.ù)~¼C²8˜}~‚­ÛÍWÛ¢íÁvKÑö¶K,8ÛÍ—�&†`[C*—ü¨ONÔÇs­ƒ �½m‚ê ò9؆Áu¶!×`{P9¦m‚êKI7oÛB*—ü¨O샹~ñ̳·Ç'­¡Á^ÝIaÏvRy!œzw'ó¤`Íx"0.Ѥb�'…iÄù|ùÌs¼žP:-%X/[´^º“#Àa°há…dÞPÓY/)Z‡Ýqˆ&-VŠÖ½ON¬Çtnƒ®G±À¹ÍY–& é›Ë’וB¿Ìœ¤¡¹M…Ánng�äŽ%¤Ò#ØœÃÉÙÇ‚"d;’Àô)ùÃ(˜\X‹³Ž¥²£0}Z¡pø�#�`Ó†Sò‹%Hvt§Ð̧f£`ú`-Î+”ÐŽQ4ó9ƒ…Ç,x›O/,îf,z»�âißn«ªÝìv«$½úæ-ÜŒå`?›“禩™|,ˆ7cïó™;Ìñº@�!osõé]Ц?ݲta0€yýÒ¥¤Zdy›«OïRÜ�<%9­äƒ€[}拇ú6m8uõIPžþhǃf>m))…YÞæê“ Ò�<%9­äƒ€[}ækçÿÜæ“WO’rõ= A} £ Ñ0'Ë 9‘S,irêÕ÷+\_ã­uâÝ¿›Ñ�ÆE?æóé{¦ƒÙÇá'È‹ÎB#4_²$&†`[–’qq‘‘&/> Mõ5^_'†`[Bý˜OõºÖÁ–%©¡ ª/]07o[šqq ’&/M Íõ5^_'nÞ¶†4.ú1Ÿ6ØsýÜ¥%]Š!ƒCÞgVe@Ù–‹’…�$)š5-ƒÃØ5}‡ä²?ÖLg+‡ |>{é>hO‘jøX5~,�ê>–0àxÕ},1’š¬ác ”ø±ŠûX€5‹ûXb$3òø³� Ú…�t¡í¡=Å>tpº8Õ‡’Ô$iÎ>´-ö¡Ç%ÀšTÔXJR#ÞgL¼í“-J/0®jãȶw.Þâªick£Z,”Ô¤š^”Ñk·ì«éUÝ ‹¯WjÇ‚µÛçƒ.Áº�UE³zÉgýãPˆ,é"›Ñe±ûÌ‹:t˜!*%~� Ö *«QÊÒ@emPMÓ1:¾Þ’àX¼�÷(˜®4æ ¤Nƒ¾]þÎJ¦' endstream endobj -618 0 obj +628 0 obj << /Producer (ESP Ghostscript 815.03) /CreationDate (D:20070123225315) /ModDate (D:20070123225315) >> endobj -619 0 obj +629 0 obj << /Type /ExtGState /OPM 1 >> endobj -620 0 obj +630 0 obj << /BaseFont /Times-Roman /Type /Font /Subtype /Type1 >> endobj -621 0 obj +631 0 obj 1397 endobj -610 0 obj << +620 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[0 1 0] /Rect [294.665 618.208 301.639 626.621] /Subtype /Link /A << /S /GoTo /D (cite.2007c) >> >> endobj -611 0 obj << +621 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[0 1 0] /Rect [305.735 618.208 312.709 626.621] /Subtype /Link /A << /S /GoTo /D (cite.2007d) >> >> endobj -616 0 obj << -/D [614 0 R /XYZ 150.705 740.998 null] +626 0 obj << +/D [624 0 R /XYZ 150.705 740.998 null] >> endobj -617 0 obj << -/D [614 0 R /XYZ 303.562 327.339 null] +627 0 obj << +/D [624 0 R /XYZ 303.562 327.339 null] >> endobj 22 0 obj << -/D [614 0 R /XYZ 150.705 252.594 null] +/D [624 0 R /XYZ 150.705 252.594 null] >> endobj -613 0 obj << -/Font << /F8 434 0 R /F27 433 0 R /F14 604 0 R /F11 587 0 R /F10 603 0 R /F16 431 0 R >> -/XObject << /Im2 612 0 R >> +623 0 obj << +/Font << /F8 442 0 R /F27 441 0 R /F14 614 0 R /F11 597 0 R /F10 613 0 R /F16 439 0 R >> +/XObject << /Im2 622 0 R >> /ProcSet [ /PDF /Text ] >> endobj -628 0 obj << +638 0 obj << /Length 5672 >> stream @@ -3697,36 +3625,36 @@ BT ET endstream endobj -627 0 obj << +637 0 obj << /Type /Page -/Contents 628 0 R -/Resources 626 0 R +/Contents 638 0 R +/Resources 636 0 R /MediaBox [0 0 595.276 841.89] -/Parent 574 0 R -/Annots [ 624 0 R 625 0 R ] +/Parent 584 0 R +/Annots [ 634 0 R 635 0 R ] >> endobj -624 0 obj << +634 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [406.358 347.355 413.331 359.31] /Subtype /Link /A << /S /GoTo /D (section.3) >> >> endobj -625 0 obj << +635 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [173.863 312.555 180.837 324.511] /Subtype /Link /A << /S /GoTo /D (section.6) >> >> endobj -629 0 obj << -/D [627 0 R /XYZ 99.895 740.998 null] +639 0 obj << +/D [637 0 R /XYZ 99.895 740.998 null] >> endobj -626 0 obj << -/Font << /F27 433 0 R /F8 434 0 R /F14 604 0 R /F30 601 0 R >> +636 0 obj << +/Font << /F27 441 0 R /F8 442 0 R /F14 614 0 R /F30 611 0 R >> /ProcSet [ /PDF /Text ] >> endobj -632 0 obj << +642 0 obj << /Length 8657 >> stream @@ -3772,48 +3700,48 @@ BT ET endstream endobj -631 0 obj << +641 0 obj << /Type /Page -/Contents 632 0 R -/Resources 630 0 R +/Contents 642 0 R +/Resources 640 0 R /MediaBox [0 0 595.276 841.89] -/Parent 574 0 R +/Parent 584 0 R >> endobj -633 0 obj << -/D [631 0 R /XYZ 150.705 740.998 null] +643 0 obj << +/D [641 0 R /XYZ 150.705 740.998 null] >> endobj 26 0 obj << -/D [631 0 R /XYZ 150.705 716.092 null] ->> endobj -635 0 obj << -/D [631 0 R /XYZ 150.705 285.279 null] ->> endobj -636 0 obj << -/D [631 0 R /XYZ 150.705 264.776 null] ->> endobj -637 0 obj << -/D [631 0 R /XYZ 150.705 243.997 null] ->> endobj -638 0 obj << -/D [631 0 R /XYZ 150.705 223.218 null] ->> endobj -639 0 obj << -/D [631 0 R /XYZ 150.705 190.483 null] ->> endobj -640 0 obj << -/D [631 0 R /XYZ 150.705 169.712 null] ->> endobj -641 0 obj << -/D [631 0 R /XYZ 150.705 150.854 null] ->> endobj -642 0 obj << -/D [631 0 R /XYZ 150.705 134.487 null] ->> endobj -630 0 obj << -/Font << /F16 431 0 R /F8 434 0 R /F11 587 0 R /F30 601 0 R /F9 634 0 R /F17 573 0 R >> -/ProcSet [ /PDF /Text ] +/D [641 0 R /XYZ 150.705 716.092 null] >> endobj 645 0 obj << +/D [641 0 R /XYZ 150.705 285.279 null] +>> endobj +646 0 obj << +/D [641 0 R /XYZ 150.705 264.776 null] +>> endobj +647 0 obj << +/D [641 0 R /XYZ 150.705 243.997 null] +>> endobj +648 0 obj << +/D [641 0 R /XYZ 150.705 223.218 null] +>> endobj +649 0 obj << +/D [641 0 R /XYZ 150.705 190.483 null] +>> endobj +650 0 obj << +/D [641 0 R /XYZ 150.705 169.712 null] +>> endobj +651 0 obj << +/D [641 0 R /XYZ 150.705 150.854 null] +>> endobj +652 0 obj << +/D [641 0 R /XYZ 150.705 134.487 null] +>> endobj +640 0 obj << +/Font << /F16 439 0 R /F8 442 0 R /F11 597 0 R /F30 611 0 R /F9 644 0 R /F17 583 0 R >> +/ProcSet [ /PDF /Text ] +>> endobj +655 0 obj << /Length 6896 >> stream @@ -3878,60 +3806,60 @@ BT ET endstream endobj -644 0 obj << -/Type /Page -/Contents 645 0 R -/Resources 643 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 660 0 R ->> endobj -646 0 obj << -/D [644 0 R /XYZ 99.895 740.998 null] ->> endobj -647 0 obj << -/D [644 0 R /XYZ 99.895 716.092 null] ->> endobj -648 0 obj << -/D [644 0 R /XYZ 99.895 685.535 null] ->> endobj -649 0 obj << -/D [644 0 R /XYZ 99.895 613.511 null] ->> endobj -650 0 obj << -/D [644 0 R /XYZ 99.895 588.43 null] ->> endobj -651 0 obj << -/D [644 0 R /XYZ 99.895 563.625 null] ->> endobj -652 0 obj << -/D [644 0 R /XYZ 99.895 526.865 null] ->> endobj -653 0 obj << -/D [644 0 R /XYZ 99.895 502.06 null] ->> endobj 654 0 obj << -/D [644 0 R /XYZ 99.895 477.255 null] ->> endobj -655 0 obj << -/D [644 0 R /XYZ 99.895 449.514 null] +/Type /Page +/Contents 655 0 R +/Resources 653 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 670 0 R >> endobj 656 0 obj << -/D [644 0 R /XYZ 99.895 419.179 null] +/D [654 0 R /XYZ 99.895 740.998 null] >> endobj 657 0 obj << -/D [644 0 R /XYZ 99.895 388.567 null] +/D [654 0 R /XYZ 99.895 716.092 null] >> endobj 658 0 obj << -/D [644 0 R /XYZ 99.895 369.91 null] +/D [654 0 R /XYZ 99.895 685.535 null] >> endobj 659 0 obj << -/D [644 0 R /XYZ 99.895 351.53 null] +/D [654 0 R /XYZ 99.895 613.511 null] >> endobj -643 0 obj << -/Font << /F8 434 0 R /F30 601 0 R >> -/ProcSet [ /PDF /Text ] +660 0 obj << +/D [654 0 R /XYZ 99.895 588.43 null] +>> endobj +661 0 obj << +/D [654 0 R /XYZ 99.895 563.625 null] +>> endobj +662 0 obj << +/D [654 0 R /XYZ 99.895 526.865 null] +>> endobj +663 0 obj << +/D [654 0 R /XYZ 99.895 502.06 null] >> endobj 664 0 obj << +/D [654 0 R /XYZ 99.895 477.255 null] +>> endobj +665 0 obj << +/D [654 0 R /XYZ 99.895 449.514 null] +>> endobj +666 0 obj << +/D [654 0 R /XYZ 99.895 419.179 null] +>> endobj +667 0 obj << +/D [654 0 R /XYZ 99.895 388.567 null] +>> endobj +668 0 obj << +/D [654 0 R /XYZ 99.895 369.91 null] +>> endobj +669 0 obj << +/D [654 0 R /XYZ 99.895 351.53 null] +>> endobj +653 0 obj << +/Font << /F8 442 0 R /F30 611 0 R >> +/ProcSet [ /PDF /Text ] +>> endobj +674 0 obj << /Length 3504 >> stream @@ -3940,7 +3868,7 @@ stream BT /F16 11.9552 Tf 150.705 706.129 Td [(2.4)-1125(Programming)-375(mo)-31(del)]TJ/F8 9.9626 Tf 0 -18.389 Td [(The)-325(PSBLAS)-324(librarary)-325(is)-325(based)-324(o)-1(n)-324(the)-325(Single)-325(Program)-324(Multiple)-325(Data)-325(\050SPMD\051)]TJ 0 -11.956 Td [(programming)-413(mo)-28(del:)-603(eac)27(h)-413(pro)-27(cess)-413(participating)-413(in)-413(the)-413(computation)-413(p)-28(erforms)]TJ 0 -11.955 Td [(the)-333(same)-334(actions)-333(on)-333(a)-334(c)28(h)28(unk)-333(of)-334(data.)-444(P)28(arallelism)-334(is)-333(th)28(us)-334(data-d)1(riv)27(en.)]TJ 14.944 -11.955 Td [(Because)-389(of)-389(this)-389(structure,)-402(m)-1(an)28(y)-389(subrou)1(tines)-389(co)-28(ordinate)-389(their)-389(action)-389(across)]TJ -14.944 -11.955 Td [(the)-478(v)56(arious)-478(pro)-28(cesses,)-514(th)28(us)-478(pro)28(viding)-477(a)-1(n)-477(implicit)-478(sync)28(hronization)-478(p)-28(oin)28(t,)-514(and)]TJ 0 -11.955 Td [(therefore)]TJ/F17 9.9626 Tf 43.026 0 Td [(must)]TJ/F8 9.9626 Tf 26.326 0 Td [(b)-28(e)-452(called)-452(sim)28(ultaneously)-452(b)28(y)-452(all)-452(pro)-28(cesses)-452(participating)-452(in)-452(the)]TJ -69.352 -11.956 Td [(computation.)-597(This)-384(is)-384(certainly)-384(true)-385(for)-384(the)-384(data)-384(allo)-28(cation)-384(and)-384(assem)28(bly)-385(rou)1(-)]TJ 0 -11.955 Td [(tines,)-333(for)-334(all)-333(the)-333(computational)-333(routines)-334(and)-333(for)-333(some)-334(of)-333(the)-333(to)-28(ols)-334(r)1(outines.)]TJ 14.944 -11.955 Td [(Ho)28(w)28(e)-1(v)28(er)-490(there)-490(are)-490(m)-1(an)28(y)-490(cases)-490(where)-491(no)-490(sync)28(hronization,)-529(and)-491(in)1(dee)-1(d)-490(no)]TJ -14.944 -11.955 Td [(comm)28(unication)-459(among)-458(pro)-28(cesses,)-489(is)-459(implied;)-521(f)1(or)-459(instance,)-489(all)-459(the)-458(routines)-458(in)]TJ 0 -11.955 Td [(sec.)]TJ 0 0 1 rg 0 0 1 RG - [-421(3.4)]TJ + [-421(3.5)]TJ 0 g 0 G [-421(are)-421(only)-420(acting)-421(on)-421(the)-421(lo)-28(cal)-421(data)-420(structures,)-443(and)-421(th)28(us)-421(ma)28(y)-421(b)-28(e)-421(called)]TJ 0 -11.955 Td [(indep)-28(enden)28(tly)84(.)-917(The)-491(most)-491(imp)-27(ortan)27(t)-490(case)-491(is)-491(that)-491(of)-490(the)-491(co)-28(e\016cien)28(t)-491(insertion)]TJ 0 -11.956 Td [(routines:)-409(since)-263(the)-263(n)27(um)28(b)-28(er)-263(of)-263(co)-27(e\016c)-1(i)1(e)-1(n)28(ts)-263(in)-263(the)-263(sparse)-263(and)-263(dense)-263(matrices)-263(v)55(aries)]TJ 0 -11.955 Td [(among)-323(the)-322(pro)-28(cessors,)-325(and)-323(since)-322(the)-323(user)-323(is)-322(free)-323(to)-323(c)28(ho)-28(ose)-322(an)-323(arbitrary)-323(ord)1(e)-1(r)-322(in)]TJ 0 -11.955 Td [(builiding)-333(the)-333(matrix)-334(en)28(tries,)-333(these)-334(routines)-333(cannot)-333(imply)-334(a)-333(sync)28(hronization.)]TJ 14.944 -11.955 Td [(Throughout)-333(this)-333(use)-1(r)1('s)-334(guide)-333(eac)28(h)-334(subroutine)-333(will)-333(b)-28(e)-333(clearly)-334(indicated)-333(as:)]TJ 0 g 0 G @@ -3957,32 +3885,32 @@ BT ET endstream endobj -663 0 obj << +673 0 obj << /Type /Page -/Contents 664 0 R -/Resources 662 0 R +/Contents 674 0 R +/Resources 672 0 R /MediaBox [0 0 595.276 841.89] -/Parent 660 0 R -/Annots [ 661 0 R ] +/Parent 670 0 R +/Annots [ 671 0 R ] >> endobj -661 0 obj << +671 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [169.454 565.254 184.177 576.103] /Subtype /Link -/A << /S /GoTo /D (subsection.3.4) >> +/A << /S /GoTo /D (subsection.3.5) >> >> endobj -665 0 obj << -/D [663 0 R /XYZ 150.705 740.998 null] +675 0 obj << +/D [673 0 R /XYZ 150.705 740.998 null] >> endobj 30 0 obj << -/D [663 0 R /XYZ 150.705 716.092 null] +/D [673 0 R /XYZ 150.705 716.092 null] >> endobj -662 0 obj << -/Font << /F16 431 0 R /F8 434 0 R /F17 573 0 R /F27 433 0 R >> +672 0 obj << +/Font << /F16 439 0 R /F8 442 0 R /F17 583 0 R /F27 441 0 R >> /ProcSet [ /PDF /Text ] >> endobj -670 0 obj << +680 0 obj << /Length 7780 >> stream @@ -4043,7 +3971,7 @@ BT 0 g 0 G [(,)-307(and)-301(its)-300(\014elds)-301(ma)28(y)]TJ 0 -11.955 Td [(b)-28(e)-387(accessed)-387(if)-387(necessary)-387(via)-387(the)-387(routines)-387(of)-387(sec.)]TJ 0 0 1 rg 0 0 1 RG - [-387(3.4)]TJ + [-387(3.5)]TJ 0 g 0 G [(;)-414(nev)28(e)-1(r)1(thele)-1(ss)-387(w)28(e)-387(include)-387(a)]TJ 0 -11.955 Td [(description)-333(for)-334(the)-333(curious)-333(reader:)]TJ 0 g 0 G @@ -4105,60 +4033,60 @@ BT ET endstream endobj -669 0 obj << +679 0 obj << /Type /Page -/Contents 670 0 R -/Resources 668 0 R +/Contents 680 0 R +/Resources 678 0 R /MediaBox [0 0 595.276 841.89] -/Parent 660 0 R -/Annots [ 666 0 R 667 0 R ] +/Parent 670 0 R +/Annots [ 676 0 R 677 0 R ] >> endobj -666 0 obj << +676 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [355.729 397.52 362.703 408.368] /Subtype /Link /A << /S /GoTo /D (section.6) >> >> endobj -667 0 obj << +677 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [311.934 385.565 326.656 396.413] /Subtype /Link -/A << /S /GoTo /D (subsection.3.4) >> +/A << /S /GoTo /D (subsection.3.5) >> >> endobj -671 0 obj << -/D [669 0 R /XYZ 99.895 740.998 null] +681 0 obj << +/D [679 0 R /XYZ 99.895 740.998 null] >> endobj 34 0 obj << -/D [669 0 R /XYZ 99.895 716.092 null] +/D [679 0 R /XYZ 99.895 716.092 null] >> endobj 38 0 obj << -/D [669 0 R /XYZ 99.895 490.352 null] +/D [679 0 R /XYZ 99.895 490.352 null] >> endobj -672 0 obj << -/D [669 0 R /XYZ 342.427 448.274 null] +682 0 obj << +/D [679 0 R /XYZ 342.427 448.274 null] >> endobj -673 0 obj << -/D [669 0 R /XYZ 99.895 269.986 null] +683 0 obj << +/D [679 0 R /XYZ 99.895 269.986 null] >> endobj -674 0 obj << -/D [669 0 R /XYZ 99.895 254.327 null] +684 0 obj << +/D [679 0 R /XYZ 99.895 254.327 null] >> endobj -675 0 obj << -/D [669 0 R /XYZ 99.895 238.668 null] +685 0 obj << +/D [679 0 R /XYZ 99.895 238.668 null] >> endobj -676 0 obj << -/D [669 0 R /XYZ 99.895 223.009 null] +686 0 obj << +/D [679 0 R /XYZ 99.895 223.009 null] >> endobj -677 0 obj << -/D [669 0 R /XYZ 99.895 207.349 null] +687 0 obj << +/D [679 0 R /XYZ 99.895 207.349 null] >> endobj -668 0 obj << -/Font << /F16 431 0 R /F8 434 0 R /F30 601 0 R /F27 433 0 R >> +678 0 obj << +/Font << /F16 439 0 R /F8 442 0 R /F30 611 0 R /F27 441 0 R >> /ProcSet [ /PDF /Text ] >> endobj -680 0 obj << +690 0 obj << /Length 6169 >> stream @@ -4315,48 +4243,48 @@ BT ET endstream endobj -679 0 obj << -/Type /Page -/Contents 680 0 R -/Resources 678 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 660 0 R ->> endobj -681 0 obj << -/D [679 0 R /XYZ 150.705 740.998 null] ->> endobj -682 0 obj << -/D [679 0 R /XYZ 150.705 685.858 null] ->> endobj -683 0 obj << -/D [679 0 R /XYZ 150.705 669.65 null] ->> endobj -684 0 obj << -/D [679 0 R /XYZ 150.705 653.443 null] ->> endobj -685 0 obj << -/D [679 0 R /XYZ 150.705 637.235 null] ->> endobj -686 0 obj << -/D [679 0 R /XYZ 150.705 621.027 null] ->> endobj -687 0 obj << -/D [679 0 R /XYZ 150.705 491.367 null] ->> endobj -688 0 obj << -/D [679 0 R /XYZ 150.705 475.159 null] ->> endobj 689 0 obj << -/D [679 0 R /XYZ 150.705 458.952 null] +/Type /Page +/Contents 690 0 R +/Resources 688 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 670 0 R >> endobj -690 0 obj << -/D [679 0 R /XYZ 198.221 180.226 null] +691 0 obj << +/D [689 0 R /XYZ 150.705 740.998 null] >> endobj -678 0 obj << -/Font << /F27 433 0 R /F8 434 0 R /F11 587 0 R /F30 601 0 R >> -/ProcSet [ /PDF /Text ] +692 0 obj << +/D [689 0 R /XYZ 150.705 685.858 null] +>> endobj +693 0 obj << +/D [689 0 R /XYZ 150.705 669.65 null] >> endobj 694 0 obj << +/D [689 0 R /XYZ 150.705 653.443 null] +>> endobj +695 0 obj << +/D [689 0 R /XYZ 150.705 637.235 null] +>> endobj +696 0 obj << +/D [689 0 R /XYZ 150.705 621.027 null] +>> endobj +697 0 obj << +/D [689 0 R /XYZ 150.705 491.367 null] +>> endobj +698 0 obj << +/D [689 0 R /XYZ 150.705 475.159 null] +>> endobj +699 0 obj << +/D [689 0 R /XYZ 150.705 458.952 null] +>> endobj +700 0 obj << +/D [689 0 R /XYZ 198.221 180.226 null] +>> endobj +688 0 obj << +/Font << /F27 441 0 R /F8 442 0 R /F11 597 0 R /F30 611 0 R >> +/ProcSet [ /PDF /Text ] +>> endobj +704 0 obj << /Length 8374 >> stream @@ -4372,7 +4300,7 @@ BT 0 g 0 G /F8 9.9626 Tf 61.508 0 Td [(State)-351(en)28(tered)-351(after)-351(the)-350(assem)27(bly;)-359(computations)-351(using)-351(the)-350(ass)-1(o)-27(ci-)]TJ -36.601 -11.955 Td [(ated)-392(sparse)-391(matrix,)-406(suc)28(h)-392(as)-391(m)-1(atr)1(ix-v)27(ector)-391(pro)-28(ducts,)-406(are)-392(only)-391(p)-28(ossible)-391(in)]TJ 0 -11.956 Td [(this)-333(state.)]TJ -24.907 -20.348 Td [(The)-344(global)-344(to)-344(lo)-27(cal)-344(index)-344(mapping)-344(ma)28(y)-344(b)-28(e)-343(stored)-344(in)-344(t)28(w)27(o)-343(di\013eren)27(t)-343(formats:)-466(the)]TJ 0 -11.955 Td [(\014rst)-323(is)-323(simpler)-323(but)-322(more)-323(exp)-28(ensiv)28(e,)-325(as)-323(it)-323(requires)-323(on)-323(eac)28(h)-323(pro)-28(cess)-323(an)-322(amoun)27(t)-322(of)]TJ 0 -11.955 Td [(memory)-368(prop)-28(ortional)-367(to)-368(the)-368(global)-368(size)-368(of)-368(the)-368(index)-368(space;)-385(the)-368(second)-368(is)-368(more)]TJ 0 -11.955 Td [(complex,)-376(but)-368(only)-367(requires)-368(memory)-368(prop)-27(ortional)-368(to)-368(the)-367(lo)-28(cal)-368(index)-367(space)-368(size.)]TJ 0 -11.955 Td [(The)-409(c)28(hoice)-409(is)-409(made)-409(at)-409(the)-409(time)-409(of)-409(the)-409(initialization)-409(according)-409(to)-409(a)-409(threshold;)]TJ 0 -11.955 Td [(this)-333(threshold)-334(ma)28(y)-333(b)-28(e)-333(queried)-334(and)-333(set)-333(using)-334(th)1(e)-334(functions)-333(in)-333(sec.)]TJ 0 0 1 rg 0 0 1 RG - [-334(3.4)]TJ + [-334(3.5)]TJ 0 g 0 G [(.)]TJ/F27 9.9626 Tf 0 -26.644 Td [(3.1.1)-1150(Named)-383(Constan)31(ts)]TJ 0 g 0 G @@ -4588,38 +4516,38 @@ BT ET endstream endobj -693 0 obj << +703 0 obj << /Type /Page -/Contents 694 0 R -/Resources 692 0 R +/Contents 704 0 R +/Resources 702 0 R /MediaBox [0 0 595.276 841.89] -/Parent 660 0 R -/Annots [ 691 0 R ] +/Parent 670 0 R +/Annots [ 701 0 R ] >> endobj -691 0 obj << +701 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [384.052 554.762 398.775 565.61] /Subtype /Link -/A << /S /GoTo /D (subsection.3.4) >> +/A << /S /GoTo /D (subsection.3.5) >> >> endobj -695 0 obj << -/D [693 0 R /XYZ 99.895 740.998 null] +705 0 obj << +/D [703 0 R /XYZ 99.895 740.998 null] >> endobj 42 0 obj << -/D [693 0 R /XYZ 99.895 541.211 null] +/D [703 0 R /XYZ 99.895 541.211 null] >> endobj 46 0 obj << -/D [693 0 R /XYZ 99.895 332.006 null] +/D [703 0 R /XYZ 99.895 332.006 null] >> endobj -696 0 obj << -/D [693 0 R /XYZ 119.642 301.203 null] +706 0 obj << +/D [703 0 R /XYZ 119.642 301.203 null] >> endobj -692 0 obj << -/Font << /F27 433 0 R /F8 434 0 R /F30 601 0 R /F16 431 0 R >> +702 0 obj << +/Font << /F27 441 0 R /F8 442 0 R /F30 611 0 R /F16 439 0 R >> /ProcSet [ /PDF /Text ] >> endobj -700 0 obj << +710 0 obj << /Length 8741 >> stream @@ -4711,7 +4639,7 @@ BT 0 g 0 G /F8 9.9626 Tf 11.028 0 Td [(Num)28(b)-28(er)-338(of)-338(columns;)-340(if)-338(column)-338(indices)-338(are)-338(stored)-338(explicitly)84(,)-339(as)-338(in)-338(Co)-28(ordinate)]TJ 13.878 -11.955 Td [(Storage)-227(or)-227(Compressed)-227(Sparse)-227(Ro)28(ws,)-248(should)-227(b)-28(e)-227(greater)-227(than)-227(or)-227(equal)-226(to)-227(the)]TJ 0 -11.955 Td [(maxim)28(um)-374(column)-374(index)-374(actually)-374(presen)28(t)-374(in)-374(the)-374(sparse)-374(matrix.)-567(Sp)-27(eci\014ed)]TJ 0 -11.956 Td [(as:)-445(i)1(n)27(teger)-333(v)56(ariable.)]TJ -24.906 -20.863 Td [(The)-328(F)84(ortran)-328(95)-327(in)28(terface)-328(for)-327(distributed)-328(sparse)-327(matrices)-328(con)28(taining)-327(double)-328(pre-)]TJ 0 -11.955 Td [(cision)-454(real)-454(en)28(tries)-454(is)-455(de\014n)1(e)-1(d)-454(as)-454(sho)28(wn)-454(in)-454(\014gure)]TJ 0 0 1 rg 0 0 1 RG - [-454(4)]TJ + [-454(5)]TJ 0 g 0 G [(.)-807(The)-454(de\014nitions)-454(for)-454(single)]TJ 0 -11.955 Td [(precision)-279(and)-280(complex)-279(data)-279(are)-280(iden)28(tical)-279(e)-1(x)1(c)-1(ept)-279(for)-279(the)]TJ/F30 9.9626 Tf 238.28 0 Td [(real)]TJ/F8 9.9626 Tf 23.705 0 Td [(declaration)-279(and)-280(for)]TJ -261.985 -11.955 Td [(the)-333(kind)-334(t)28(yp)-27(e)-334(parameter.)]TJ 14.944 -12.268 Td [(The)-333(follo)28(w)-1(i)1(ng)-334(t)28(w)28(o)-334(cases)-333(are)-333(among)-334(the)-333(most)-334(commonly)-333(used:)]TJ 0 g 0 G @@ -4744,41 +4672,41 @@ BT ET endstream endobj -699 0 obj << +709 0 obj << /Type /Page -/Contents 700 0 R -/Resources 698 0 R +/Contents 710 0 R +/Resources 708 0 R /MediaBox [0 0 595.276 841.89] -/Parent 660 0 R -/Annots [ 697 0 R ] +/Parent 670 0 R +/Annots [ 707 0 R ] >> endobj -697 0 obj << +707 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [365.682 363.997 372.656 374.845] /Subtype /Link -/A << /S /GoTo /D (figure.4) >> +/A << /S /GoTo /D (figure.5) >> >> endobj -701 0 obj << -/D [699 0 R /XYZ 150.705 740.998 null] +711 0 obj << +/D [709 0 R /XYZ 150.705 740.998 null] >> endobj -702 0 obj << -/D [699 0 R /XYZ 150.705 291.019 null] +712 0 obj << +/D [709 0 R /XYZ 150.705 291.019 null] >> endobj -703 0 obj << -/D [699 0 R /XYZ 150.705 236.097 null] +713 0 obj << +/D [709 0 R /XYZ 150.705 236.097 null] >> endobj -704 0 obj << -/D [699 0 R /XYZ 150.705 182.345 null] +714 0 obj << +/D [709 0 R /XYZ 150.705 182.345 null] >> endobj -705 0 obj << -/D [699 0 R /XYZ 150.705 165.779 null] +715 0 obj << +/D [709 0 R /XYZ 150.705 165.779 null] >> endobj -698 0 obj << -/Font << /F27 433 0 R /F8 434 0 R /F30 601 0 R /F11 587 0 R /F14 604 0 R >> +708 0 obj << +/Font << /F27 441 0 R /F8 442 0 R /F30 611 0 R /F11 597 0 R /F14 614 0 R >> /ProcSet [ /PDF /Text ] >> endobj -709 0 obj << +719 0 obj << /Length 3645 >> stream @@ -4827,25 +4755,25 @@ BT ET endstream endobj -708 0 obj << +718 0 obj << /Type /Page -/Contents 709 0 R -/Resources 707 0 R +/Contents 719 0 R +/Resources 717 0 R /MediaBox [0 0 595.276 841.89] -/Parent 711 0 R +/Parent 722 0 R >> endobj -710 0 obj << -/D [708 0 R /XYZ 99.895 740.998 null] +720 0 obj << +/D [718 0 R /XYZ 99.895 740.998 null] >> endobj -706 0 obj << -/D [708 0 R /XYZ 155.561 201.167 null] ->> endobj -707 0 obj << -/Font << /F30 601 0 R /F8 434 0 R /F27 433 0 R >> -/ProcSet [ /PDF /Text ] +721 0 obj << +/D [718 0 R /XYZ 155.561 201.167 null] >> endobj 717 0 obj << -/Length 9164 +/Font << /F30 611 0 R /F8 442 0 R /F27 441 0 R >> +/ProcSet [ /PDF /Text ] +>> endobj +725 0 obj << +/Length 7685 >> stream 0 g 0 G @@ -4853,1102 +4781,810 @@ stream BT /F8 9.9626 Tf 175.611 706.129 Td [(matrix,)-333(suc)27(h)-333(as)-333(matrix-v)28(e)-1(ctor)-333(pro)-28(du)1(c)-1(ts,)-333(are)-333(only)-334(p)-27(ossible)-334(in)-333(this)-333(state;)]TJ 0 g 0 G -/F27 9.9626 Tf -24.906 -18.508 Td [(Up)-32(date:)]TJ +/F27 9.9626 Tf -24.906 -21.816 Td [(Up)-32(date:)]TJ 0 g 0 G -/F8 9.9626 Tf 45.302 0 Td [(State)-233(en)27(tered)-233(after)-233(a)-234(r)1(e)-1(in)1(italization;)-267(this)-233(is)-234(used)-233(to)-233(handle)-234(appli)1(c)-1(ation)1(s)]TJ -20.396 -11.955 Td [(in)-395(whic)28(h)-396(the)-395(same)-395(sparsit)28(y)-395(pattern)-396(is)-395(used)-395(m)28(ultiple)-395(times)-396(with)-395(di\013eren)28(t)]TJ 0 -11.955 Td [(co)-28(e\016cien)28(ts.)-427(In)-280(this)-280(state)-280(it)-281(i)1(s)-281(only)-280(p)-27(os)-1(sibl)1(e)-281(to)-280(en)28(ter)-280(co)-28(e\016cien)28(ts)-281(f)1(or)-281(already)]TJ 0 -11.955 Td [(existing)-333(nonzero)-334(en)28(tries.)]TJ/F27 9.9626 Tf -24.906 -25.286 Td [(3.2.1)-1150(Named)-383(Constan)32(ts)]TJ +/F8 9.9626 Tf 45.302 0 Td [(State)-233(en)27(tered)-233(after)-233(a)-234(r)1(e)-1(in)1(italization;)-267(this)-233(is)-234(used)-233(to)-233(handle)-234(appli)1(c)-1(ation)1(s)]TJ -20.396 -11.955 Td [(in)-395(whic)28(h)-396(the)-395(same)-395(sparsit)28(y)-395(pattern)-396(is)-395(used)-395(m)28(ultiple)-395(times)-396(with)-395(di\013eren)28(t)]TJ 0 -11.955 Td [(co)-28(e\016cien)28(ts.)-427(In)-280(this)-280(state)-280(it)-281(i)1(s)-281(only)-280(p)-27(os)-1(sibl)1(e)-281(to)-280(en)28(ter)-280(co)-28(e\016cien)28(ts)-281(f)1(or)-281(already)]TJ 0 -11.955 Td [(existing)-333(nonzero)-334(en)28(tries.)]TJ/F27 9.9626 Tf -24.906 -28.404 Td [(3.2.1)-1150(Named)-383(Constan)32(ts)]TJ 0 g 0 G - 0 -18.389 Td [(psb)]TJ + 0 -19.269 Td [(psb)]TJ ET q -1 0 0 1 168.641 608.28 cm +1 0 0 1 168.641 600.974 cm []0 d 0 J 0.398 w 0 0 m 3.437 0 l S Q BT -/F27 9.9626 Tf 172.078 608.081 Td [(dupl)]TJ +/F27 9.9626 Tf 172.078 600.775 Td [(dupl)]TJ ET q -1 0 0 1 195.043 608.28 cm +1 0 0 1 195.043 600.974 cm []0 d 0 J 0.398 w 0 0 m 3.437 0 l S Q BT -/F27 9.9626 Tf 198.48 608.081 Td [(o)32(vwrt)]TJ +/F27 9.9626 Tf 198.48 600.775 Td [(o)32(vwrt)]TJ ET q -1 0 0 1 228.073 608.28 cm +1 0 0 1 228.073 600.974 cm []0 d 0 J 0.398 w 0 0 m 3.437 0 l S Q 0 g 0 G BT -/F8 9.9626 Tf 236.492 608.081 Td [(Duplicate)-315(co)-28(e\016cien)28(ts)-315(should)-315(b)-28(e)-315(o)28(v)28(erwritten)-315(\050i.e.)-438(ignore)-315(du-)]TJ -60.881 -11.956 Td [(plications\051)]TJ +/F8 9.9626 Tf 236.492 600.775 Td [(Duplicate)-315(co)-28(e\016cien)28(ts)-315(should)-315(b)-28(e)-315(o)28(v)28(erwritten)-315(\050i.e.)-438(ignore)-315(du-)]TJ -60.881 -11.955 Td [(plications\051)]TJ 0 g 0 G -/F27 9.9626 Tf -24.906 -18.507 Td [(psb)]TJ +/F27 9.9626 Tf -24.906 -21.816 Td [(psb)]TJ ET q -1 0 0 1 168.641 577.817 cm +1 0 0 1 168.641 567.203 cm []0 d 0 J 0.398 w 0 0 m 3.437 0 l S Q BT -/F27 9.9626 Tf 172.078 577.618 Td [(dupl)]TJ +/F27 9.9626 Tf 172.078 567.004 Td [(dupl)]TJ ET q -1 0 0 1 195.043 577.817 cm +1 0 0 1 195.043 567.203 cm []0 d 0 J 0.398 w 0 0 m 3.437 0 l S Q BT -/F27 9.9626 Tf 198.48 577.618 Td [(add)]TJ +/F27 9.9626 Tf 198.48 567.004 Td [(add)]TJ ET q -1 0 0 1 217.467 577.817 cm +1 0 0 1 217.467 567.203 cm []0 d 0 J 0.398 w 0 0 m 3.437 0 l S Q 0 g 0 G BT -/F8 9.9626 Tf 225.886 577.618 Td [(Duplicate)-333(co)-28(e\016cien)28(ts)-334(should)-333(b)-28(e)-333(added;)]TJ +/F8 9.9626 Tf 225.886 567.004 Td [(Duplicate)-333(co)-28(e\016cien)28(ts)-334(should)-333(b)-28(e)-333(added;)]TJ 0 g 0 G -/F27 9.9626 Tf -75.181 -18.508 Td [(psb)]TJ +/F27 9.9626 Tf -75.181 -21.816 Td [(psb)]TJ ET q -1 0 0 1 168.641 559.309 cm +1 0 0 1 168.641 545.387 cm []0 d 0 J 0.398 w 0 0 m 3.437 0 l S Q BT -/F27 9.9626 Tf 172.078 559.11 Td [(dupl)]TJ +/F27 9.9626 Tf 172.078 545.188 Td [(dupl)]TJ ET q -1 0 0 1 195.043 559.309 cm +1 0 0 1 195.043 545.387 cm []0 d 0 J 0.398 w 0 0 m 3.437 0 l S Q BT -/F27 9.9626 Tf 198.48 559.11 Td [(err)]TJ +/F27 9.9626 Tf 198.48 545.188 Td [(err)]TJ ET q -1 0 0 1 213.856 559.309 cm +1 0 0 1 213.856 545.387 cm []0 d 0 J 0.398 w 0 0 m 3.437 0 l S Q 0 g 0 G BT -/F8 9.9626 Tf 222.274 559.11 Td [(Duplicate)-333(co)-28(e\016cien)28(ts)-334(should)-333(trigger)-333(an)-334(error)-333(conditino)]TJ +/F8 9.9626 Tf 222.274 545.188 Td [(Duplicate)-333(co)-28(e\016cien)28(ts)-334(should)-333(trigger)-333(an)-334(error)-333(conditino)]TJ 0 g 0 G -/F27 9.9626 Tf -71.569 -18.508 Td [(psb)]TJ +/F27 9.9626 Tf -71.569 -21.816 Td [(psb)]TJ ET q -1 0 0 1 168.641 540.801 cm +1 0 0 1 168.641 523.572 cm []0 d 0 J 0.398 w 0 0 m 3.437 0 l S Q BT -/F27 9.9626 Tf 172.078 540.602 Td [(up)-32(d)]TJ +/F27 9.9626 Tf 172.078 523.372 Td [(up)-32(d)]TJ ET q -1 0 0 1 192.179 540.801 cm +1 0 0 1 192.179 523.572 cm []0 d 0 J 0.398 w 0 0 m 3.437 0 l S Q BT -/F27 9.9626 Tf 195.616 540.602 Td [(d\015t)]TJ +/F27 9.9626 Tf 195.616 523.372 Td [(d\015t)]TJ ET q -1 0 0 1 213.489 540.801 cm +1 0 0 1 213.489 523.572 cm []0 d 0 J 0.398 w 0 0 m 3.437 0 l S Q 0 g 0 G BT -/F8 9.9626 Tf 221.907 540.602 Td [(Default)-333(up)-28(date)-333(strategy)-334(for)-333(matrix)-333(co)-28(e\016cien)28(ts;)]TJ +/F8 9.9626 Tf 221.907 523.372 Td [(Default)-333(up)-28(date)-333(strategy)-334(for)-333(matrix)-333(co)-28(e\016cien)28(ts;)]TJ 0 g 0 G -/F27 9.9626 Tf -71.202 -18.508 Td [(psb)]TJ +/F27 9.9626 Tf -71.202 -21.816 Td [(psb)]TJ ET q -1 0 0 1 168.641 522.293 cm +1 0 0 1 168.641 501.756 cm []0 d 0 J 0.398 w 0 0 m 3.437 0 l S Q BT -/F27 9.9626 Tf 172.078 522.094 Td [(up)-32(d)]TJ +/F27 9.9626 Tf 172.078 501.556 Td [(up)-32(d)]TJ ET q -1 0 0 1 192.179 522.293 cm +1 0 0 1 192.179 501.756 cm []0 d 0 J 0.398 w 0 0 m 3.437 0 l S Q BT -/F27 9.9626 Tf 195.616 522.094 Td [(src)32(h)]TJ +/F27 9.9626 Tf 195.616 501.556 Td [(src)32(h)]TJ ET q -1 0 0 1 216.68 522.293 cm +1 0 0 1 216.68 501.756 cm []0 d 0 J 0.398 w 0 0 m 3.437 0 l S Q 0 g 0 G BT -/F8 9.9626 Tf 225.098 522.094 Td [(Up)-28(date)-333(strategy)-333(base)-1(d)-333(on)-333(searc)28(h)-334(in)28(to)-333(the)-334(data)-333(structure;)]TJ +/F8 9.9626 Tf 225.098 501.556 Td [(Up)-28(date)-333(strategy)-333(base)-1(d)-333(on)-333(searc)28(h)-334(in)28(to)-333(the)-334(data)-333(structure;)]TJ 0 g 0 G -/F27 9.9626 Tf -74.393 -18.508 Td [(psb)]TJ +/F27 9.9626 Tf -74.393 -21.815 Td [(psb)]TJ ET q -1 0 0 1 168.641 503.786 cm +1 0 0 1 168.641 479.94 cm []0 d 0 J 0.398 w 0 0 m 3.437 0 l S Q BT -/F27 9.9626 Tf 172.078 503.586 Td [(up)-32(d)]TJ +/F27 9.9626 Tf 172.078 479.741 Td [(up)-32(d)]TJ ET q -1 0 0 1 192.179 503.786 cm +1 0 0 1 192.179 479.94 cm []0 d 0 J 0.398 w 0 0 m 3.437 0 l S Q BT -/F27 9.9626 Tf 195.616 503.586 Td [(p)-32(erm)]TJ +/F27 9.9626 Tf 195.616 479.741 Td [(p)-32(erm)]TJ ET q -1 0 0 1 222.504 503.786 cm +1 0 0 1 222.504 479.94 cm []0 d 0 J 0.398 w 0 0 m 3.437 0 l S Q 0 g 0 G BT -/F8 9.9626 Tf 230.922 503.586 Td [(Up)-28(date)-398(strategy)-398(based)-398(on)-398(additional)-398(p)-28(erm)28(utation)-398(data)-398(\050s)-1(ee)]TJ -55.311 -11.955 Td [(to)-28(ols)-333(routine)-333(desc)-1(r)1(iption\051.)]TJ/F16 11.9552 Tf -24.906 -27.278 Td [(3.3)-1125(Preconditioner)-375(data)-375(structure)]TJ/F8 9.9626 Tf 0 -18.389 Td [(Our)-383(base)-383(library)-383(o\013ers)-383(supp)-28(ort)-383(for)-383(simple)-383(w)28(ell)-383(kno)27(wn)-383(precondition)1(e)-1(r)1(s)-384(lik)28(e)-383(Di-)]TJ 0 -11.956 Td [(agonal)-333(Scaling)-334(or)-333(Blo)-28(c)28(k)-333(Jacobi)-334(with)-333(incomplete)-333(factorization)-333(ILU\0500\051.)]TJ 14.944 -11.955 Td [(A)-427(preconditioner)-428(is)-427(held)-428(in)-427(the)]TJ/F30 9.9626 Tf 142.723 0 Td [(psb)]TJ +/F8 9.9626 Tf 230.922 479.741 Td [(Up)-28(date)-398(strategy)-398(based)-398(on)-398(additional)-398(p)-28(erm)28(utation)-398(data)-398(\050s)-1(ee)]TJ -55.311 -11.956 Td [(to)-28(ols)-333(routine)-333(desc)-1(r)1(iption\051.)]TJ/F16 11.9552 Tf -24.906 -30.396 Td [(3.3)-1125(Dense)-375(V)94(ector)-375(Data)-375(Structure)]TJ/F8 9.9626 Tf 0 -19.269 Td [(The)]TJ/F30 9.9626 Tf 20.327 0 Td [(psb)]TJ ET q -1 0 0 1 324.691 422.253 cm +1 0 0 1 187.351 418.32 cm []0 d 0 J 0.398 w 0 0 m 3.138 0 l S Q BT -/F30 9.9626 Tf 327.829 422.053 Td [(prec)]TJ +/F30 9.9626 Tf 190.489 418.12 Td [(vect)]TJ ET q -1 0 0 1 349.378 422.253 cm +1 0 0 1 212.038 418.32 cm []0 d 0 J 0.398 w 0 0 m 3.138 0 l S Q BT -/F30 9.9626 Tf 352.516 422.053 Td [(type)]TJ/F8 9.9626 Tf 25.18 0 Td [(data)-427(structure)-428(rep)-28(orted)-427(in)]TJ -226.991 -11.955 Td [(\014gure)]TJ -0 0 1 rg 0 0 1 RG - [-361(5)]TJ +/F30 9.9626 Tf 215.177 418.12 Td [(type)]TJ/F8 9.9626 Tf 24.091 0 Td [(data)-318(structure)-318(con)28(tains)-319(all)-318(information)-318(ab)-27(out)-319(lo)-27(cal)-319(p)-27(ortion)]TJ -88.563 -11.955 Td [(of)-374(the)-374(sparse)-375(matrix)-374(and)-374(its)-374(storage)-374(mo)-28(de.)-567(Most)-374(of)-374(these)-375(\014elds)-374(are)-374(set)-374(b)28(y)-375(the)]TJ 0 -11.955 Td [(to)-28(ols)-348(routines)-349(when)-349(inserting)-348(a)-349(new)-349(sparse)-348(matrix;)-357(the)-348(user)-349(needs)-349(only)-348(c)27(ho)-27(ose,)]TJ 0 -11.955 Td [(if)-333(he/she)-334(so)-333(whishes,)-333(a)-334(sp)-28(eci\014c)-333(matrix)-333(storage)-334(mo)-27(de.)]TJ 0 g 0 G - [(.)-527(The)]TJ/F30 9.9626 Tf 61.729 0 Td [(psb_prec_type)]TJ/F8 9.9626 Tf 71.59 0 Td [(data)-361(t)28(yp)-28(e)-361(ma)28(y)-361(con)28(tain)-361(a)-361(simple)-361(preconditionin)1(g)]TJ -133.319 -11.955 Td [(matrix)-395(with)-396(the)-395(asso)-28(ciated)-396(comm)28(unication)-395(desc)-1(r)1(iptor.The)-396(v)56(alues)-396(con)28(tained)-395(in)]TJ 0 -11.955 Td [(the)]TJ/F30 9.9626 Tf 16.637 0 Td [(iprcparm)]TJ/F8 9.9626 Tf 44.642 0 Td [(and)]TJ/F30 9.9626 Tf 18.851 0 Td [(rprcparm)]TJ/F8 9.9626 Tf 44.642 0 Td [(de\014ne)-281(tha)-281(t)28(yp)-28(e)-281(of)-281(preconditioner)-281(along)-281(with)-281(all)-281(the)]TJ -124.772 -11.955 Td [(parameters)-420(related)-421(to)-420(it;)-464(th)28(us,)]TJ/F30 9.9626 Tf 139.397 0 Td [(iprcparm)]TJ/F8 9.9626 Tf 46.03 0 Td [(and)]TJ/F30 9.9626 Tf 20.239 0 Td [(rprcparm)]TJ/F8 9.9626 Tf 46.03 0 Td [(de\014ne)-420(ho)28(w)-421(the)-420(other)]TJ -251.696 -11.956 Td [(records)-282(ha)28(v)28(e)-282(to)-282(b)-27(e)-282(in)28(terpreted.)-428(This)-281(data)-282(structure)-282(is)-282(the)-281(basis)-282(of)-282(more)-282(complex)]TJ 0 -11.955 Td [(preconditioning)-333(strategies,)-334(whic)28(h)-333(are)-333(the)-334(sub)-55(ject)-334(of)-333(further)-333(researc)28(h.)]TJ/F16 11.9552 Tf 0 -27.278 Td [(3.4)-1125(Data)-375(structure)-375(query)-375(routines)]TJ/F27 9.9626 Tf 0 -18.389 Td [(psb)]TJ -ET -q -1 0 0 1 168.641 304.854 cm -[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S -Q -BT -/F27 9.9626 Tf 172.078 304.655 Td [(cd)]TJ -ET -q -1 0 0 1 184.223 304.854 cm -[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S -Q -BT -/F27 9.9626 Tf 187.66 304.655 Td [(get)]TJ -ET -q -1 0 0 1 203.782 304.854 cm -[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S -Q -BT -/F27 9.9626 Tf 207.22 304.655 Td [(lo)-32(cal)]TJ -ET -q -1 0 0 1 230.98 304.854 cm -[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S -Q -BT -/F27 9.9626 Tf 234.417 304.655 Td [(ro)32(ws)-383(|)-384(Get)-383(n)32(um)32(b)-32(er)-383(of)-384(lo)-32(cal)-383(ro)32(ws)]TJ +/F27 9.9626 Tf 0 -33.298 Td [(aspk)]TJ 0 g 0 G +/F8 9.9626 Tf 27.481 0 Td [(Con)28(tains)-334(v)56(alues)-333(of)-334(the)-333(lo)-28(cal)-333(distributed)-333(sparse)-334(matrix.)]TJ -2.574 -11.956 Td [(Sp)-28(eci\014ed)-430(as)-1(:)-639(an)-431(allo)-27(catable)-431(arra)28(y)-431(of)-431(rank)-431(on)1(e)-431(of)-431(t)28(yp)-28(e)-431(corresp)-28(ondin)1(g)-431(to)]TJ 0 -11.955 Td [(matrix)-333(en)28(tries)-334(t)28(yp)-28(e.)]TJ 0 g 0 G -/F30 9.9626 Tf -83.712 -18.389 Td [(nr)-525(=)-525(psb_cd_get_local_rows\050desc\051)]TJ +/F27 9.9626 Tf -24.907 -21.816 Td [(ia1)]TJ 0 g 0 G -/F27 9.9626 Tf 0 -18.375 Td [(T)32(yp)-32(e:)]TJ +/F8 9.9626 Tf 19.462 0 Td [(Holds)-266(in)28(teger)-267(in)1(formation)-267(on)-266(distributed)-266(sparse)-266(matrix.)-422(Actual)-266(information)]TJ 5.445 -11.955 Td [(will)-333(dep)-28(end)-333(on)-334(data)-333(format)-333(used.)]TJ 0 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-444(an)-334(allo)-28(catable)-333(in)28(teger)-333(arra)27(y)-333(of)-333(rank)-333(one.)]TJ 0 g 0 G -/F8 9.9626 Tf 33.797 0 Td [(Async)28(hronous.)]TJ +/F27 9.9626 Tf -24.907 -21.816 Td [(ia2)]TJ 0 g 0 G -/F27 9.9626 Tf -33.797 -18.507 Td [(On)-383(En)32(try)]TJ +/F8 9.9626 Tf 19.462 0 Td [(Holds)-266(in)28(teger)-267(in)1(formation)-267(on)-266(distributed)-266(sparse)-266(matrix.)-422(Actual)-266(information)]TJ 5.445 -11.955 Td [(will)-333(dep)-28(end)-333(on)-334(data)-333(format)-333(used.)]TJ 0 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-444(an)-334(allo)-28(catable)-333(in)28(teger)-333(arra)27(y)-333(of)-333(rank)-333(one.)]TJ 0 g 0 G +/F27 9.9626 Tf -24.907 -21.816 Td [(infoa)]TJ 0 g 0 G - 0 -18.508 Td [(desc)]TJ +/F8 9.9626 Tf 29.327 0 Td [(On)-435(en)28(try)-434(can)-435(hold)-435(auxiliar)1(y)-435(information)-435(on)-434(distributed)-435(sparse)-434(matrix.)]TJ -4.42 -11.955 Td [(Actual)-333(information)-333(will)-334(dep)-27(e)-1(nd)-333(on)-333(data)-333(format)-334(used.)]TJ 0 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-444(a)-1(n)-333(in)28(teger)-333(arra)27(y)-333(of)-333(length)]TJ/F30 9.9626 Tf 172.547 0 Td [(psb_ifasize_)]TJ/F8 9.9626 Tf 62.764 0 Td [(.)]TJ 0 g 0 G -/F8 9.9626 Tf 26.208 0 Td [(the)-333(comm)27(unication)-333(descriptor.)]TJ -1.302 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf 23.073 0 Td [(.)]TJ -55.452 -11.956 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.612 0 Td [(required)]TJ/F8 9.9626 Tf 41.898 0 Td [(.)]TJ -71.51 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(in)]TJ/F8 9.9626 Tf 9.548 0 Td [(.)]TJ -43.034 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-445(a)-333(structured)-333(data)-333(of)-334(t)28(yp)-28(e)]TJ -0 0 1 rg 0 0 1 RG -/F30 9.9626 Tf 170.915 0 Td [(psb)]TJ -ET -q -1 0 0 1 362.845 183.254 cm -[]0 d 0 J 0.398 w 0 0 m 3.138 0 l S -Q -BT -/F30 9.9626 Tf 365.983 183.055 Td [(desc)]TJ -ET -q -1 0 0 1 387.532 183.254 cm -[]0 d 0 J 0.398 w 0 0 m 3.138 0 l S -Q -BT -/F30 9.9626 Tf 390.67 183.055 Td [(type)]TJ +/F27 9.9626 Tf -260.218 -21.816 Td [(\014da)]TJ 0 g 0 G -/F8 9.9626 Tf 20.922 0 Td [(.)]TJ +/F8 9.9626 Tf 23.281 0 Td [(De\014nes)-333(the)-334(format)-333(of)-333(the)-334(distrib)1(uted)-334(sparse)-333(matrix.)]TJ 1.626 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-444(a)-334(string)-333(of)-333(length)-334(5)]TJ 0 g 0 G -/F27 9.9626 Tf -260.887 -18.374 Td [(On)-383(Return)]TJ +/F27 9.9626 Tf -24.907 -21.816 Td [(descra)]TJ 0 g 0 G +/F8 9.9626 Tf 36.496 0 Td [(Describ)-28(e)-333(the)-334(c)28(haracteristic)-333(of)-333(the)-334(distributed)-333(sparse)-333(matrix.)]TJ -11.589 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-444(a)-1(r)1(ra)27(y)-333(of)-333(c)27(har)1(ac)-1(ter)-333(of)-333(length)-333(9.)]TJ 0 g 0 G - 0 -18.508 Td [(F)96(unction)-384(v)64(alue)]TJ -0 g 0 G -/F8 9.9626 Tf 78.386 0 Td [(The)-460(n)28(um)27(b)-27(er)-461(of)-460(lo)-28(cal)-460(ro)28(ws,)-492(i.e.)-825(the)-460(n)28(um)27(b)-27(er)-461(of)-460(ro)28(ws)-460(o)28(wned)]TJ -53.48 -11.955 Td [(b)28(y)-401(the)-401(curren)27(t)-401(pro)-27(ces)-1(s;)-435(as)-401(explained)-401(in)]TJ -0 0 1 rg 0 0 1 RG - [-401(1)]TJ -0 g 0 G - [(,)-418(it)-401(is)-401(equal)-401(to)]TJ/F14 9.9626 Tf 249.678 0 Td [(jI)]TJ/F10 6.9738 Tf 8.192 -1.494 Td [(i)]TJ/F14 9.9626 Tf 3.317 1.494 Td [(j)]TJ/F8 9.9626 Tf 5.431 0 Td [(+)]TJ/F14 9.9626 Tf 10.413 0 Td [(jB)]TJ/F10 6.9738 Tf 9.311 -1.494 Td [(i)]TJ/F14 9.9626 Tf 3.317 1.494 Td [(j)]TJ/F8 9.9626 Tf 2.767 0 Td [(.)-648(The)]TJ -292.426 -11.955 Td [(returned)-333(v)55(alue)-333(is)-333(sp)-28(eci\014c)-334(to)-333(the)-333(calling)-334(p)1(ro)-28(cess.)]TJ -0 g 0 G - 141.968 -31.825 Td [(14)]TJ + 141.967 -29.888 Td [(14)]TJ 0 g 0 G ET endstream endobj -716 0 obj << +724 0 obj << /Type /Page -/Contents 717 0 R -/Resources 715 0 R +/Contents 725 0 R +/Resources 723 0 R /MediaBox [0 0 595.276 841.89] -/Parent 711 0 R -/Annots [ 712 0 R 713 0 R 714 0 R ] +/Parent 722 0 R >> endobj -712 0 obj << -/Type /Annot -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [177.685 406.888 184.659 418.013] -/Subtype /Link -/A << /S /GoTo /D (figure.5) >> ->> endobj -713 0 obj << -/Type /Annot -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [345.53 179.845 412.588 190.97] -/Subtype /Link -/A << /S /GoTo /D (descdata) >> ->> endobj -714 0 obj << -/Type /Annot -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [351.231 130.731 358.204 142.686] -/Subtype /Link -/A << /S /GoTo /D (section.1) >> ->> endobj -718 0 obj << -/D [716 0 R /XYZ 150.705 740.998 null] +726 0 obj << +/D [724 0 R /XYZ 150.705 740.998 null] >> endobj 50 0 obj << -/D [716 0 R /XYZ 150.705 636.488 null] +/D [724 0 R /XYZ 150.705 630.535 null] >> endobj 54 0 obj << -/D [716 0 R /XYZ 150.705 475.81 null] ->> endobj -719 0 obj << -/D [716 0 R /XYZ 308.372 422.053 null] ->> endobj -58 0 obj << -/D [716 0 R /XYZ 150.705 335.055 null] ->> endobj -62 0 obj << -/D [716 0 R /XYZ 150.705 296.283 null] ->> endobj -715 0 obj << -/Font << /F8 434 0 R /F27 433 0 R /F16 431 0 R /F30 601 0 R /F14 604 0 R /F10 603 0 R >> -/ProcSet [ /PDF /Text ] ->> endobj -724 0 obj << -/Length 4183 ->> -stream -0 g 0 G -0 g 0 G -0 g 0 G -0 g 0 G -0 g 0 G -q -1 0 0 1 107.177 705.93 cm -[]0 d 0 J 0.398 w 0 0 m 329.147 0 l S -Q -q -1 0 0 1 107.377 251.434 cm -[]0 d 0 J 0.398 w 0 0 m 0 454.296 l S -Q -0 g 0 G -0 g 0 G -BT -/F46 8.9664 Tf 124.961 686.801 Td [(type)-525(psb_sprec_type)]TJ 9.414 -10.959 Td [(type\050psb_sspmat_type\051,)-525(allocatable)-525(::)-525(av\050:\051)]TJ 0 -10.958 Td [(real\050psb_spk_\051,)-525(allocatable)-4200(::)-525(d\050:\051)]TJ 0 -10.959 Td [(type\050psb_desc_type\051)-8400(::)-525(desc_data)]TJ 0 -10.959 Td [(integer,)-525(allocatable)-7875(::)-525(iprcparm\050:\051)]TJ 0 -10.959 Td [(real\050psb_spk_\051,)-525(allocatable)-4200(::)-525(rprcparm\050:\051)]TJ 0 -10.959 Td [(integer,)-525(allocatable)-7875(::)-525(perm\050:\051,)-1050(invperm\050:\051)]TJ 0 -10.959 Td [(integer)-14700(::)-525(prec,)-525(base_prec)]TJ -9.414 -10.959 Td [(end)-525(type)-525(psb_sprec_type)]TJ 0 -21.918 Td [(type)-525(psb_dprec_type)]TJ 9.414 -10.959 Td [(type\050psb_dspmat_type\051,)-525(allocatable)-525(::)-525(av\050:\051)]TJ 0 -10.958 Td [(real\050psb_dpk_\051,)-525(allocatable)-4200(::)-525(d\050:\051)]TJ 0 -10.959 Td [(type\050psb_desc_type\051)-8400(::)-525(desc_data)]TJ 0 -10.959 Td [(integer,)-525(allocatable)-7875(::)-525(iprcparm\050:\051)]TJ 0 -10.959 Td [(real\050psb_dpk_\051,)-525(allocatable)-4200(::)-525(rprcparm\050:\051)]TJ 0 -10.959 Td [(integer,)-525(allocatable)-7875(::)-525(perm\050:\051,)-1050(invperm\050:\051)]TJ 0 -10.959 Td [(integer)-14700(::)-525(prec,)-525(base_prec)]TJ -9.414 -10.959 Td [(end)-525(type)-525(psb_dprec_type)]TJ 0 -21.918 Td [(type)-525(psb_cprec_type)]TJ 9.414 -10.959 Td [(type\050psb_cspmat_type\051,)-525(allocatable)-525(::)-525(av\050:\051)]TJ 0 -10.958 Td [(complex\050psb_spk_\051,)-525(allocatable)-2625(::)-525(d\050:\051)]TJ 0 -10.959 Td [(type\050psb_desc_type\051)-8400(::)-525(desc_data)]TJ 0 -10.959 Td [(integer,)-525(allocatable)-7875(::)-525(iprcparm\050:\051)]TJ 0 -10.959 Td [(real\050psb_spk_\051,)-525(allocatable)-4200(::)-525(rprcparm\050:\051)]TJ 0 -10.959 Td [(integer,)-525(allocatable)-7875(::)-525(perm\050:\051,)-1050(invperm\050:\051)]TJ 0 -10.959 Td [(integer)-14700(::)-525(prec,)-525(base_prec)]TJ -9.414 -10.959 Td [(end)-525(type)-525(psb_cprec_type)]TJ 0 -21.918 Td [(type)-525(psb_zprec_type)]TJ 9.414 -10.959 Td [(type\050psb_zspmat_type\051,)-525(allocatable)-525(::)-525(av\050:\051)]TJ 0 -10.959 Td [(complex\050psb_dpk_\051,)-525(allocatable)-2625(::)-525(d\050:\051)]TJ 0 -10.958 Td [(type\050psb_desc_type\051)-8400(::)-525(desc_data)]TJ 0 -10.959 Td [(integer,)-525(allocatable)-7875(::)-525(iprcparm\050:\051)]TJ 0 -10.959 Td [(real\050psb_dpk_\051,)-525(allocatable)-4200(::)-525(rprcparm\050:\051)]TJ 0 -10.959 Td [(integer,)-525(allocatable)-7875(::)-525(perm\050:\051,)-1050(invperm\050:\051)]TJ 0 -10.959 Td [(integer)-14700(::)-525(prec,)-525(base_prec)]TJ -9.414 -10.959 Td [(end)-525(type)-525(psb_zprec_type)]TJ -ET -q -1 0 0 1 436.125 251.434 cm -[]0 d 0 J 0.398 w 0 0 m 0 454.296 l S -Q -q -1 0 0 1 107.177 251.235 cm -[]0 d 0 J 0.398 w 0 0 m 329.147 0 l S -Q -0 g 0 G -BT -/F8 9.9626 Tf 111.864 223.195 Td [(Figure)-333(5:)-445(The)-333(PSBLAS)-333(de\014ned)-334(data)-333(t)28(yp)-28(e)-333(that)-333(c)-1(on)28(tains)-333(a)-333(preconditioner.)]TJ -0 g 0 G -0 g 0 G -/F27 9.9626 Tf -11.969 -33.816 Td [(psb)]TJ -ET -q -1 0 0 1 117.832 189.579 cm -[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S -Q -BT -/F27 9.9626 Tf 121.269 189.379 Td [(cd)]TJ -ET -q -1 0 0 1 133.413 189.579 cm -[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S -Q -BT -/F27 9.9626 Tf 136.85 189.379 Td [(get)]TJ -ET -q -1 0 0 1 152.973 189.579 cm -[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S -Q -BT -/F27 9.9626 Tf 156.41 189.379 Td [(lo)-32(cal)]TJ -ET -q -1 0 0 1 180.17 189.579 cm -[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S -Q -BT -/F27 9.9626 Tf 183.608 189.379 Td [(cols)-383(|)-384(Get)-383(n)32(um)32(b)-32(er)-383(of)-384(lo)-32(cal)-383(cols)]TJ -0 g 0 G -0 g 0 G -/F30 9.9626 Tf -83.713 -20.242 Td [(nc)-525(=)-525(psb_cd_get_local_cols\050desc\051)]TJ -0 g 0 G -/F27 9.9626 Tf 0 -24.904 Td [(On)-383(En)32(try)]TJ -0 g 0 G -0 g 0 G - 0 -23.907 Td [(T)32(yp)-32(e:)]TJ -0 g 0 G -/F8 9.9626 Tf 33.797 0 Td [(Async)28(hronous.)]TJ -0 g 0 G - 133.078 -29.888 Td [(15)]TJ -0 g 0 G -ET -endstream -endobj -723 0 obj << -/Type /Page -/Contents 724 0 R -/Resources 722 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 711 0 R ->> endobj -725 0 obj << -/D [723 0 R /XYZ 99.895 740.998 null] ->> endobj -720 0 obj << -/D [723 0 R /XYZ 155.478 235.151 null] ->> endobj -66 0 obj << -/D [723 0 R /XYZ 99.895 180.151 null] ->> endobj -722 0 obj << -/Font << /F46 726 0 R /F8 434 0 R /F27 433 0 R /F30 601 0 R >> -/ProcSet [ /PDF /Text ] ->> endobj -733 0 obj << -/Length 6210 ->> -stream -0 g 0 G -0 g 0 G -0 g 0 G -BT -/F27 9.9626 Tf 150.705 706.129 Td [(desc)]TJ -0 g 0 G -/F8 9.9626 Tf 26.208 0 Td [(the)-333(comm)27(unication)-333(descriptor.)]TJ -1.302 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf 23.073 0 Td [(.)]TJ -55.452 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.612 0 Td [(required)]TJ/F8 9.9626 Tf 41.898 0 Td [(.)]TJ -71.51 -11.956 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(in)]TJ/F8 9.9626 Tf 9.547 0 Td [(.)]TJ -43.033 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-445(a)-333(structured)-333(data)-333(of)-334(t)28(yp)-28(e)]TJ -0 0 1 rg 0 0 1 RG -/F30 9.9626 Tf 170.915 0 Td [(psb)]TJ -ET -q -1 0 0 1 362.845 658.507 cm -[]0 d 0 J 0.398 w 0 0 m 3.138 0 l S -Q -BT -/F30 9.9626 Tf 365.983 658.308 Td [(desc)]TJ -ET -q -1 0 0 1 387.532 658.507 cm -[]0 d 0 J 0.398 w 0 0 m 3.138 0 l S -Q -BT -/F30 9.9626 Tf 390.67 658.308 Td [(type)]TJ -0 g 0 G -/F8 9.9626 Tf 20.922 0 Td [(.)]TJ -0 g 0 G -/F27 9.9626 Tf -260.887 -25.418 Td [(On)-383(Return)]TJ -0 g 0 G -0 g 0 G - 0 -24.593 Td [(F)96(unction)-384(v)64(alue)]TJ -0 g 0 G -/F8 9.9626 Tf 78.386 0 Td [(The)-361(n)28(um)28(b)-28(er)-360(of)-361(lo)-27(cal)-361(cols,)-367(i.e.)-526(the)-361(n)28(um)28(b)-28(er)-360(of)-361(indices)-360(used)-361(b)28(y)]TJ -53.48 -11.955 Td [(the)-421(curren)28(t)-421(pro)-28(cess,)-443(including)-421(b)-27(oth)-421(lo)-28(cal)-421(and)-421(halo)-421(ind)1(ice)-1(s;)-464(as)-421(explained)]TJ 0 -11.956 Td [(in)]TJ -0 0 1 rg 0 0 1 RG - [-344(1)]TJ -0 g 0 G - [(,)-346(it)-343(is)-344(equal)-343(to)]TJ/F14 9.9626 Tf 81.777 0 Td [(jI)]TJ/F10 6.9738 Tf 8.192 -1.494 Td [(i)]TJ/F14 9.9626 Tf 3.317 1.494 Td [(j)]TJ/F8 9.9626 Tf 5.049 0 Td [(+)]TJ/F14 9.9626 Tf 10.031 0 Td [(jB)]TJ/F10 6.9738 Tf 9.311 -1.494 Td [(i)]TJ/F14 9.9626 Tf 3.317 1.494 Td [(j)]TJ/F8 9.9626 Tf 5.049 0 Td [(+)]TJ/F14 9.9626 Tf 10.03 0 Td [(jH)]TJ/F10 6.9738 Tf 11.181 -1.494 Td [(i)]TJ/F14 9.9626 Tf 3.317 1.494 Td [(j)]TJ/F8 9.9626 Tf 2.768 0 Td [(.)-475(The)-344(returned)-343(v)55(al)1(ue)-344(is)-344(sp)-27(ec)-1(i)1(\014c)-344(to)-344(the)]TJ -153.339 -11.955 Td [(calling)-333(pro)-28(cess.)]TJ/F27 9.9626 Tf -24.906 -32.087 Td [(psb)]TJ -ET -q -1 0 0 1 168.641 540.544 cm -[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S -Q -BT -/F27 9.9626 Tf 172.078 540.344 Td [(cd)]TJ -ET -q -1 0 0 1 184.223 540.544 cm -[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S -Q -BT -/F27 9.9626 Tf 187.66 540.344 Td [(get)]TJ -ET -q -1 0 0 1 203.782 540.544 cm -[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S -Q -BT -/F27 9.9626 Tf 207.22 540.344 Td [(global)]TJ -ET -q -1 0 0 1 237.663 540.544 cm -[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S -Q -BT -/F27 9.9626 Tf 241.1 540.344 Td [(ro)32(ws)-383(|)-384(Get)-383(n)32(um)32(b)-32(er)-383(of)-384(global)-383(ro)32(ws)]TJ -0 g 0 G -0 g 0 G -/F30 9.9626 Tf -90.395 -20.561 Td [(nr)-525(=)-525(psb_cd_get_global_rows\050desc\051)]TJ -0 g 0 G -/F27 9.9626 Tf 0 -25.418 Td [(On)-383(En)32(try)]TJ -0 g 0 G -0 g 0 G - 0 -24.593 Td [(T)32(yp)-32(e:)]TJ -0 g 0 G -/F8 9.9626 Tf 33.797 0 Td [(Async)28(hronous.)]TJ -0 g 0 G -/F27 9.9626 Tf -33.797 -24.593 Td [(desc)]TJ -0 g 0 G -/F8 9.9626 Tf 26.208 0 Td [(the)-333(comm)27(unication)-333(descriptor.)]TJ -1.302 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf 23.073 0 Td [(.)]TJ -55.452 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.612 0 Td [(required)]TJ/F8 9.9626 Tf 41.898 0 Td [(.)]TJ -71.51 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(in)]TJ/F8 9.9626 Tf 9.548 0 Td [(.)]TJ -43.034 -11.956 Td [(Sp)-28(eci\014ed)-333(as:)-445(a)-333(structured)-333(data)-333(of)-334(t)28(yp)-28(e)]TJ -0 0 1 rg 0 0 1 RG -/F30 9.9626 Tf 170.915 0 Td [(psb)]TJ -ET -q -1 0 0 1 362.845 397.558 cm -[]0 d 0 J 0.398 w 0 0 m 3.138 0 l S -Q -BT -/F30 9.9626 Tf 365.983 397.358 Td [(desc)]TJ -ET -q -1 0 0 1 387.532 397.558 cm -[]0 d 0 J 0.398 w 0 0 m 3.138 0 l S -Q -BT -/F30 9.9626 Tf 390.67 397.358 Td [(type)]TJ -0 g 0 G -/F8 9.9626 Tf 20.922 0 Td [(.)]TJ -0 g 0 G -/F27 9.9626 Tf -260.887 -25.418 Td [(On)-383(Return)]TJ -0 g 0 G -0 g 0 G - 0 -24.593 Td [(F)96(unction)-384(v)64(alue)]TJ -0 g 0 G -/F8 9.9626 Tf 78.386 0 Td [(The)-333(n)27(um)28(b)-28(er)-333(of)-333(global)-333(ro)27(ws)-333(in)-333(the)-334(mesh)]TJ/F27 9.9626 Tf -78.386 -32.087 Td [(psb)]TJ -ET -q -1 0 0 1 168.641 315.459 cm -[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S -Q -BT -/F27 9.9626 Tf 172.078 315.26 Td [(cd)]TJ -ET -q -1 0 0 1 184.223 315.459 cm -[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S -Q -BT -/F27 9.9626 Tf 187.66 315.26 Td [(get)]TJ -ET -q -1 0 0 1 203.782 315.459 cm -[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S -Q -BT -/F27 9.9626 Tf 207.22 315.26 Td [(global)]TJ -ET -q -1 0 0 1 237.663 315.459 cm -[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S -Q -BT -/F27 9.9626 Tf 241.1 315.26 Td [(cols)-383(|)-384(Get)-383(n)32(um)32(b)-32(er)-383(of)-384(global)-383(cols)]TJ -0 g 0 G -0 g 0 G -/F30 9.9626 Tf -90.395 -20.561 Td [(nr)-525(=)-525(psb_cd_get_global_cols\050desc\051)]TJ -0 g 0 G -/F27 9.9626 Tf 0 -25.418 Td [(T)32(yp)-32(e:)]TJ -0 g 0 G -/F8 9.9626 Tf 33.797 0 Td [(Async)28(hronous.)]TJ -0 g 0 G -/F27 9.9626 Tf -33.797 -24.593 Td [(On)-383(En)32(try)]TJ -0 g 0 G -0 g 0 G - 0 -24.593 Td [(desc)]TJ -0 g 0 G -/F8 9.9626 Tf 26.208 0 Td [(the)-333(comm)27(unication)-333(descriptor.)]TJ -1.302 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf 23.073 0 Td [(.)]TJ -55.452 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.612 0 Td [(required)]TJ/F8 9.9626 Tf 41.898 0 Td [(.)]TJ -71.51 -11.956 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(in)]TJ/F8 9.9626 Tf 9.548 0 Td [(.)]TJ -43.034 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-445(a)-333(structured)-333(data)-333(of)-334(t)28(yp)-28(e)]TJ -0 0 1 rg 0 0 1 RG -/F30 9.9626 Tf 170.915 0 Td [(psb)]TJ -ET -q -1 0 0 1 362.845 172.473 cm -[]0 d 0 J 0.398 w 0 0 m 3.138 0 l S -Q -BT -/F30 9.9626 Tf 365.983 172.274 Td [(desc)]TJ -ET -q -1 0 0 1 387.532 172.473 cm -[]0 d 0 J 0.398 w 0 0 m 3.138 0 l S -Q -BT -/F30 9.9626 Tf 390.67 172.274 Td [(type)]TJ -0 g 0 G -/F8 9.9626 Tf 20.922 0 Td [(.)]TJ -0 g 0 G -/F27 9.9626 Tf -260.887 -25.418 Td [(On)-383(Return)]TJ -0 g 0 G -0 g 0 G - 0 -24.593 Td [(F)96(unction)-384(v)64(alue)]TJ -0 g 0 G -/F8 9.9626 Tf 78.386 0 Td [(The)-333(n)27(um)28(b)-28(er)-333(of)-333(global)-333(cols)-334(in)-333(the)-333(me)-1(sh)]TJ -0 g 0 G - 88.488 -31.825 Td [(16)]TJ -0 g 0 G -ET -endstream -endobj -732 0 obj << -/Type /Page -/Contents 733 0 R -/Resources 731 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 711 0 R -/Annots [ 721 0 R 727 0 R 728 0 R 729 0 R ] ->> endobj -721 0 obj << -/Type /Annot -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [345.53 655.098 412.588 666.223] -/Subtype /Link -/A << /S /GoTo /D (descdata) >> +/D [724 0 R /XYZ 150.705 449.319 null] >> endobj 727 0 obj << -/Type /Annot -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [186.34 580.9 193.314 592.855] -/Subtype /Link -/A << /S /GoTo /D (section.1) >> +/D [724 0 R /XYZ 171.032 418.12 null] +>> endobj +723 0 obj << +/Font << /F8 442 0 R /F27 441 0 R /F16 439 0 R /F30 611 0 R >> +/ProcSet [ /PDF /Text ] +>> endobj +731 0 obj << +/Length 9027 +>> +stream +0 g 0 G +0 g 0 G +0 g 0 G +BT +/F27 9.9626 Tf 99.895 706.129 Td [(pl)]TJ +0 g 0 G +/F8 9.9626 Tf 14.529 0 Td [(Sp)-28(eci\014es)-352(the)-353(lo)-28(cal)-352(ro)28(w)-353(p)-28(erm)28(utation)-353(of)-352(distributed)-352(s)-1(p)1(arse)-353(matrix.)-502(If)-353(pl\0501\051)-352(is)]TJ 10.378 -11.955 Td [(equal)-333(to)-334(0,)-333(then)-333(there)-334(isn't)-333(ro)28(w)-333(p)-28(erm)28(utation.)]TJ 0 -11.955 Td [(Sp)-28(eci\014ed)-302(as:)-429(an)-302(allo)-28(catable)-302(in)28(teger)-302(arra)28(y)-302(of)-302(dimension)-302(equal)-302(to)-303(n)28(um)28(b)-28(er)-302(of)]TJ 0 -11.956 Td [(lo)-28(cal)-333(ro)28(w)-334(\050matrix)]TJ +ET +q +1 0 0 1 201.005 670.463 cm +[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S +Q +BT +/F8 9.9626 Tf 203.994 670.263 Td [(data[psb)]TJ +ET +q +1 0 0 1 241.73 670.463 cm +[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S +Q +BT +/F8 9.9626 Tf 244.719 670.263 Td [(n)]TJ +ET +q +1 0 0 1 250.852 670.463 cm +[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S +Q +BT +/F8 9.9626 Tf 253.841 670.263 Td [(ro)28(w)]TJ +ET +q +1 0 0 1 270.24 670.463 cm +[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S +Q +BT +/F8 9.9626 Tf 273.229 670.263 Td [(]\051)]TJ +0 g 0 G +/F27 9.9626 Tf -173.334 -20.089 Td [(pr)]TJ +0 g 0 G +/F8 9.9626 Tf 16.065 0 Td [(Sp)-28(eci\014es)-512(the)-512(lo)-28(cal)-512(column)-512(p)-27(erm)27(utation)-511(of)-512(distributed)-512(sparse)-512(matrix.)-981(If)]TJ 8.842 -11.955 Td [(PR\0501\051)-333(is)-334(equal)-333(to)-333(0,)-334(then)-333(there)-333(isn't)-334(columnm)-333(p)-28(erm)28(utation.)]TJ 0 -11.955 Td [(Sp)-28(eci\014ed)-302(as:)-429(an)-302(allo)-28(catable)-302(in)28(teger)-302(arra)28(y)-302(of)-302(dimension)-302(equal)-302(to)-303(n)28(um)28(b)-28(er)-302(of)]TJ 0 -11.955 Td [(lo)-28(cal)-333(ro)28(w)-334(\050matrix)]TJ +ET +q +1 0 0 1 201.005 614.508 cm +[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S +Q +BT +/F8 9.9626 Tf 203.994 614.309 Td [(data[psb)]TJ +ET +q +1 0 0 1 241.73 614.508 cm +[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S +Q +BT +/F8 9.9626 Tf 244.719 614.309 Td [(n)]TJ +ET +q +1 0 0 1 250.852 614.508 cm +[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S +Q +BT +/F8 9.9626 Tf 253.841 614.309 Td [(col)]TJ +ET +q +1 0 0 1 266.615 614.508 cm +[]0 d 0 J 0.398 w 0 0 m 2.989 0 l S +Q +BT +/F8 9.9626 Tf 269.604 614.309 Td [(]\051)]TJ +0 g 0 G +/F27 9.9626 Tf -169.709 -20.089 Td [(m)]TJ +0 g 0 G +/F8 9.9626 Tf 14.529 0 Td [(Num)28(b)-28(er)-244(of)-243(ro)27(ws;)-273(if)-244(ro)28(w)-244(indices)-243(are)-244(stored)-244(explicitly)84(,)-262(as)-244(in)-243(Co)-28(ordinate)-244(Storage,)]TJ 10.378 -11.956 Td [(should)-225(b)-27(e)-225(greater)-225(than)-225(or)-224(equal)-225(to)-225(the)-225(maxim)28(um)-225(ro)28(w)-225(index)-224(actually)-225(presen)28(t)]TJ 0 -11.955 Td [(in)-333(the)-334(sparse)-333(matrix.)-444(Sp)-28(eci\014ed)-333(as)-1(:)-444(in)28(teger)-333(v)55(ariable.)]TJ +0 g 0 G +/F27 9.9626 Tf -24.907 -20.089 Td [(k)]TJ +0 g 0 G +/F8 9.9626 Tf 11.028 0 Td [(Num)28(b)-28(er)-338(of)-338(columns;)-340(if)-338(column)-338(indices)-338(are)-338(stored)-338(explicitly)84(,)-339(as)-338(in)-338(Co)-28(ordinate)]TJ 13.879 -11.955 Td [(Storage)-227(or)-227(Compressed)-227(Sparse)-227(Ro)28(ws,)-248(should)-227(b)-28(e)-227(greater)-227(than)-227(or)-226(e)-1(qu)1(al)-227(to)-227(the)]TJ 0 -11.955 Td [(maxim)28(um)-374(column)-374(index)-374(actually)-374(presen)28(t)-374(in)-374(the)-374(sparse)-374(matrix.)-567(Sp)-27(eci\014ed)]TJ 0 -11.955 Td [(as:)-444(in)27(teger)-333(v)56(ariable.)]TJ -24.907 -20.048 Td [(The)-328(F)84(ortran)-328(95)-327(in)28(terface)-328(for)-327(distributed)-328(sparse)-327(matrices)-328(con)28(taining)-327(double)-328(pre-)]TJ 0 -11.956 Td [(cision)-454(real)-454(en)28(tries)-455(i)1(s)-455(de\014ned)-454(as)-454(sho)28(wn)-454(in)-454(\014gure)]TJ +0 0 1 rg 0 0 1 RG + [-454(5)]TJ +0 g 0 G + [(.)-807(The)-454(de\014nitions)-454(for)-454(single)]TJ 0 -11.955 Td [(precision)-279(and)-280(complex)-279(data)-280(are)-279(iden)28(tical)-280(except)-279(for)-279(the)]TJ/F30 9.9626 Tf 238.281 0 Td [(real)]TJ/F8 9.9626 Tf 23.704 0 Td [(declaration)-279(and)-280(for)]TJ -261.985 -11.955 Td [(the)-333(kind)-334(t)28(yp)-28(e)-333(parameter.)]TJ 14.944 -11.996 Td [(The)-333(follo)27(wing)-333(t)28(w)28(o)-334(cases)-333(are)-334(among)-333(the)-333(most)-334(commonly)-333(used:)]TJ +0 g 0 G +/F27 9.9626 Tf -14.944 -20.048 Td [(\014da=\134CSR")]TJ +0 g 0 G +/F8 9.9626 Tf 67.435 0 Td [(Compressed)-380(s)-1(t)1(o)-1(r)1(age)-381(b)28(y)-380(ro)27(ws.)-585(In)-381(th)1(is)-381(case)-380(the)-381(follo)28(wing)-380(should)]TJ -42.528 -11.955 Td [(hold:)]TJ +0 g 0 G + 9.188 -20.09 Td [(1.)]TJ +0 g 0 G +/F30 9.9626 Tf 12.73 0 Td [(ia2\050i\051)]TJ/F8 9.9626 Tf 36.202 0 Td [(con)28(tains)-484(the)-484(index)-483(of)-484(the)-484(\014rst)-484(elemen)28(t)-484(of)-484(r)1(o)27(w)]TJ/F30 9.9626 Tf 212.908 0 Td [(i)]TJ/F8 9.9626 Tf 5.23 0 Td [(;)-559(the)-484(last)]TJ -254.34 -11.955 Td [(elemen)28(t)-274(of)-273(the)-274(sparse)-273(matrix)-273(is)-274(th)28(us)-273(store)-1(d)-273(at)-273(index)]TJ/F11 9.9626 Tf 222.702 0 Td [(ia)]TJ/F8 9.9626 Tf 8.698 0 Td [(2\050)]TJ/F11 9.9626 Tf 8.856 0 Td [(m)]TJ/F8 9.9626 Tf 9.767 0 Td [(+)-102(1\051)]TJ/F14 9.9626 Tf 18.645 0 Td [(\000)]TJ/F8 9.9626 Tf 8.769 0 Td [(1.)-424(It)]TJ -277.437 -11.955 Td [(should)-248(con)28(tain)]TJ/F30 9.9626 Tf 65.055 0 Td [(m+1)]TJ/F8 9.9626 Tf 18.164 0 Td [(en)28(tries)-249(i)1(n)-249(nondecreasing)-248(order)-248(\050strictly)-248(increasing,)]TJ -83.219 -11.955 Td [(if)-333(there)-334(are)-333(no)-333(empt)27(y)-333(ro)28(ws\051.)]TJ +0 g 0 G + -12.73 -16.022 Td [(2.)]TJ +0 g 0 G +/F30 9.9626 Tf 12.73 0 Td [(ia1\050j\051)]TJ/F8 9.9626 Tf 35.118 0 Td [(con)28(tains)-375(the)-375(column)-375(index)-375(and)]TJ/F30 9.9626 Tf 139.394 0 Td [(aspk\050j\051)]TJ/F8 9.9626 Tf 40.349 0 Td [(con)28(tains)-375(the)-375(corre-)]TJ -214.861 -11.955 Td [(sp)-28(onding)-333(co)-28(e\016cien)28(t)-333(v)55(alue,)-333(for)-333(all)]TJ/F11 9.9626 Tf 146.479 0 Td [(ia)]TJ/F8 9.9626 Tf 8.698 0 Td [(2\0501\051)]TJ/F14 9.9626 Tf 20.479 0 Td [(\024)]TJ/F11 9.9626 Tf 10.516 0 Td [(j)]TJ/F14 9.9626 Tf 7.44 0 Td [(\024)]TJ/F11 9.9626 Tf 10.516 0 Td [(ia)]TJ/F8 9.9626 Tf 8.699 0 Td [(2\050)]TJ/F11 9.9626 Tf 8.855 0 Td [(m)]TJ/F8 9.9626 Tf 10.962 0 Td [(+)-222(1\051)]TJ/F14 9.9626 Tf 21.032 0 Td [(\000)]TJ/F8 9.9626 Tf 9.962 0 Td [(1.)]TJ +0 g 0 G +/F27 9.9626 Tf -310.462 -20.09 Td [(\014da=\134COO")]TJ +0 g 0 G +/F8 9.9626 Tf 69.689 0 Td [(Co)-28(ordinate)-333(storage.)-445(In)-333(this)-333(case)-334(the)-333(follo)28(wing)-333(should)-334(hold:)]TJ +0 g 0 G + -35.595 -20.089 Td [(1.)]TJ +0 g 0 G +/F30 9.9626 Tf 12.73 0 Td [(infoa\0501\051)]TJ/F8 9.9626 Tf 45.164 0 Td [(con)28(tains)-333(the)-334(n)28(um)28(b)-28(er)-333(of)-334(nonzero)-333(elemen)28(ts)-334(in)-333(the)-333(matrix;)]TJ +0 g 0 G + -57.894 -16.022 Td [(2.)]TJ +0 g 0 G + [-500(F)83(or)-269(all)-269(1)]TJ/F14 9.9626 Tf 50.92 0 Td [(\024)]TJ/F11 9.9626 Tf 10.516 0 Td [(j)]TJ/F14 9.9626 Tf 7.441 0 Td [(\024)]TJ/F11 9.9626 Tf 10.516 0 Td [(inf)-108(oa)]TJ/F8 9.9626 Tf 25.457 0 Td [(\0501\051,)-282(the)-270(co)-27(e)-1(\016cien)28(t,)-282(ro)28(w)-270(index)-269(and)-269(c)-1(ol)1(umn)-270(index)]TJ -92.12 -11.955 Td [(are)-333(stored)-334(in)28(to)]TJ/F30 9.9626 Tf 66.805 0 Td [(apsk\050j\051)]TJ/F8 9.9626 Tf 36.612 0 Td [(,)]TJ/F30 9.9626 Tf 6.089 0 Td [(ia1\050j\051)]TJ/F8 9.9626 Tf 34.703 0 Td [(and)]TJ/F30 9.9626 Tf 19.372 0 Td [(ia2\050j\051)]TJ/F8 9.9626 Tf 34.702 0 Td [(resp)-28(ectiv)28(ely)83(.)]TJ -245.107 -20.089 Td [(A)-333(sparse)-334(matrix)-333(has)-333(an)-334(asso)-28(ciated)-333(state,)-333(whic)28(h)-334(can)-333(tak)28(e)-334(the)-333(follo)28(wing)-333(v)55(alues:)]TJ +0 g 0 G +/F27 9.9626 Tf 0 -20.048 Td [(Build:)]TJ +0 g 0 G +/F8 9.9626 Tf 35.408 0 Td [(State)-306(en)28(tered)-307(af)1(te)-1(r)-306(the)-306(\014rst)-306(allo)-28(cation,)-311(and)-306(b)-28(efore)-306(the)-306(\014rst)-306(assem)27(bly;)-315(in)]TJ -10.502 -11.955 Td [(this)-333(state)-334(it)-333(is)-333(p)-28(ossible)-334(to)-333(add)-333(nonzero)-333(en)27(tries.)]TJ +0 g 0 G +/F27 9.9626 Tf -24.906 -20.09 Td [(Assem)32(bled:)]TJ +0 g 0 G +/F8 9.9626 Tf 61.507 0 Td [(State)-373(en)27(tered)-373(after)-373(the)-374(assem)28(bly;)-393(computations)-374(u)1(s)-1(i)1(ng)-374(the)-373(sparse)]TJ -36.601 -11.955 Td [(matrix,)-333(suc)27(h)-333(as)-333(matrix-v)28(ec)-1(tor)-333(pro)-28(du)1(c)-1(ts,)-333(are)-333(only)-333(p)-28(ossible)-334(in)-333(this)-333(state;)]TJ +0 g 0 G +/F27 9.9626 Tf -24.906 -20.089 Td [(Up)-32(date:)]TJ +0 g 0 G +/F8 9.9626 Tf 45.302 0 Td [(State)-233(en)27(tered)-233(after)-233(a)-233(reinitalization;)-267(this)-233(is)-234(used)-233(to)-233(handle)-234(app)1(lications)]TJ -20.396 -11.955 Td [(in)-395(whic)28(h)-396(th)1(e)-396(same)-395(sparsit)28(y)-395(pattern)-396(is)-395(used)-395(m)28(ultiple)-395(times)-396(with)-395(di\013eren)28(t)]TJ 0 -11.955 Td [(co)-28(e\016cien)28(ts.)-427(In)-280(this)-280(state)-280(it)-280(is)-281(only)-280(p)-27(oss)-1(ib)1(le)-281(to)-280(en)28(ter)-280(co)-28(e\016cien)28(ts)-280(for)-281(already)]TJ 0 -11.955 Td [(existing)-333(nonzero)-334(en)28(tries.)]TJ +0 g 0 G + 141.968 -31.825 Td [(15)]TJ +0 g 0 G +ET +endstream +endobj +730 0 obj << +/Type /Page +/Contents 731 0 R +/Resources 729 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 722 0 R +/Annots [ 728 0 R ] >> endobj 728 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] -/Rect [345.53 394.148 412.588 405.273] +/Rect [314.873 479.418 321.846 490.266] /Subtype /Link -/A << /S /GoTo /D (descdata) >> +/A << /S /GoTo /D (figure.5) >> >> endobj -729 0 obj << -/Type /Annot -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [345.53 169.064 412.588 180.189] -/Subtype /Link -/A << /S /GoTo /D (descdata) >> +732 0 obj << +/D [730 0 R /XYZ 99.895 740.998 null] +>> endobj +733 0 obj << +/D [730 0 R /XYZ 99.895 408.341 null] >> endobj 734 0 obj << -/D [732 0 R /XYZ 150.705 740.998 null] +/D [730 0 R /XYZ 99.895 353.963 null] >> endobj -70 0 obj << -/D [732 0 R /XYZ 150.705 530.968 null] +735 0 obj << +/D [730 0 R /XYZ 99.895 302.383 null] >> endobj -74 0 obj << -/D [732 0 R /XYZ 150.705 305.884 null] +736 0 obj << +/D [730 0 R /XYZ 99.895 286.361 null] >> endobj -731 0 obj << -/Font << /F27 433 0 R /F8 434 0 R /F30 601 0 R /F14 604 0 R /F10 603 0 R >> +729 0 obj << +/Font << /F27 441 0 R /F8 442 0 R /F30 611 0 R /F11 597 0 R /F14 614 0 R >> /ProcSet [ /PDF /Text ] >> endobj -738 0 obj << -/Length 5016 +739 0 obj << +/Length 3677 >> stream 0 g 0 G 0 g 0 G 0 g 0 G 0 g 0 G -BT -/F16 11.9552 Tf 99.895 679.356 Td [(psb)]TJ -ET +0 g 0 G q -1 0 0 1 120.951 679.556 cm -[]0 d 0 J 0.398 w 0 0 m 4.035 0 l S +1 0 0 1 166.453 705.93 cm +[]0 d 0 J 0.398 w 0 0 m 312.215 0 l S Q -BT -/F16 11.9552 Tf 124.986 679.356 Td [(cd)]TJ -ET q -1 0 0 1 139.243 679.556 cm -[]0 d 0 J 0.398 w 0 0 m 4.035 0 l S +1 0 0 1 166.652 217.45 cm +[]0 d 0 J 0.398 w 0 0 m 0 488.28 l S Q -BT -/F16 11.9552 Tf 143.278 679.356 Td [(get)]TJ -ET -q -1 0 0 1 162.177 679.556 cm -[]0 d 0 J 0.398 w 0 0 m 4.035 0 l S -Q -BT -/F16 11.9552 Tf 166.211 679.356 Td [(con)31(text|Get)-375(comm)31(unication)-375(con)32(text)]TJ 0 g 0 G 0 g 0 G -/F30 9.9626 Tf -66.316 -31.045 Td [(ictxt)-525(=)-525(psb_cd_get_context\050desc\051)]TJ +BT +/F30 9.9626 Tf 174.822 691.672 Td [(type)-525(psb_sspmat_type)]TJ 15.691 -11.955 Td [(integer)-2625(::)-525(m,)-525(k)]TJ 0 -11.955 Td [(character)-1575(::)-525(fida\0505\051)]TJ 0 -11.956 Td [(character)-1575(::)-525(descra\05010\051)]TJ 0 -11.955 Td [(integer)-2625(::)-525(infoa\050psb_ifa_size_\051)]TJ 0 -11.955 Td [(real\050psb_spk_\051,)-525(allocatable)-525(::)-525(aspk\050:\051)]TJ 0 -11.955 Td [(integer,)-525(allocatable)-525(::)-525(ia1\050:\051,)-525(ia2\050:\051)]TJ 0 -11.955 Td [(integer,)-525(allocatable)-525(::)-525(pr\050:\051,)-525(pl\050:\051)]TJ -15.691 -11.955 Td [(end)-525(type)-525(psb_sspmat_type)]TJ 0 -23.911 Td [(type)-525(psb_dspmat_type)]TJ 15.691 -11.955 Td [(integer)-2625(::)-525(m,)-525(k)]TJ 0 -11.955 Td [(character)-1575(::)-525(fida\0505\051)]TJ 0 -11.955 Td [(character)-1575(::)-525(descra\05010\051)]TJ 0 -11.955 Td [(integer)-2625(::)-525(infoa\050psb_ifa_size_\051)]TJ 0 -11.956 Td [(real\050psb_dpk_\051,)-525(allocatable)-525(::)-525(aspk\050:\051)]TJ 0 -11.955 Td [(integer,)-525(allocatable)-525(::)-525(ia1\050:\051,)-525(ia2\050:\051)]TJ 0 -11.955 Td [(integer,)-525(allocatable)-525(::)-525(pr\050:\051,)-525(pl\050:\051)]TJ -15.691 -11.955 Td [(end)-525(type)-525(psb_dspmat_type)]TJ 0 -23.91 Td [(type)-525(psb_cspmat_type)]TJ 15.691 -11.956 Td [(integer)-2625(::)-525(m,)-525(k)]TJ 0 -11.955 Td [(character)-1575(::)-525(fida\0505\051)]TJ 0 -11.955 Td [(character)-1575(::)-525(descra\05010\051)]TJ 0 -11.955 Td [(integer)-2625(::)-525(infoa\050psb_ifa_size_\051)]TJ 0 -11.955 Td [(complex\050psb_spk_\051,)-525(allocatable)-525(::)-525(aspk\050:\051)]TJ 0 -11.956 Td [(integer,)-525(allocatable)-525(::)-525(ia1\050:\051,)-525(ia2\050:\051)]TJ 0 -11.955 Td [(integer,)-525(allocatable)-525(::)-525(pr\050:\051,)-525(pl\050:\051)]TJ -15.691 -11.955 Td [(end)-525(type)-525(psb_cspmat_type)]TJ 0 -23.91 Td [(type)-525(psb_zspmat_type)]TJ 15.691 -11.955 Td [(integer)-2625(::)-525(m,)-525(k)]TJ 0 -11.956 Td [(character)-1575(::)-525(fida\0505\051)]TJ 0 -11.955 Td [(character)-1575(::)-525(descra\05010\051)]TJ 0 -11.955 Td [(integer)-2625(::)-525(infoa\050psb_ifa_size_\051)]TJ 0 -11.955 Td [(complex\050psb_dpk_\051,)-525(allocatable)-525(::)-525(aspk\050:\051)]TJ 0 -11.955 Td [(integer,)-525(allocatable)-525(::)-525(ia1\050:\051,)-525(ia2\050:\051)]TJ 0 -11.955 Td [(integer,)-525(allocatable)-525(::)-525(pr\050:\051,)-525(pl\050:\051)]TJ -15.691 -11.956 Td [(end)-525(type)-525(psb_zspmat_type)]TJ +ET +q +1 0 0 1 478.468 217.45 cm +[]0 d 0 J 0.398 w 0 0 m 0 488.28 l S +Q +q +1 0 0 1 166.453 217.251 cm +[]0 d 0 J 0.398 w 0 0 m 312.215 0 l S +Q 0 g 0 G -/F27 9.9626 Tf 0 -25.559 Td [(T)32(yp)-32(e:)]TJ +BT +/F8 9.9626 Tf 162.757 189.212 Td [(Figure)-333(5:)-778(The)-333(PSBLAS)-334(de\014ned)-333(data)-333(t)28(yp)-28(e)-333(that)-334(con)28(tains)-333(a)-334(sparse)-333(matrix.)]TJ +0 g 0 G +0 g 0 G +/F27 9.9626 Tf -12.052 -35.304 Td [(3.3.1)-1150(Named)-383(Constan)32(ts)]TJ +0 g 0 G + 0 -21.627 Td [(psb)]TJ +ET +q +1 0 0 1 168.641 132.48 cm +[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S +Q +BT +/F27 9.9626 Tf 172.078 132.281 Td [(dupl)]TJ +ET +q +1 0 0 1 195.043 132.48 cm +[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S +Q +BT +/F27 9.9626 Tf 198.48 132.281 Td [(o)32(vwrt)]TJ +ET +q +1 0 0 1 228.073 132.48 cm +[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S +Q +0 g 0 G +BT +/F8 9.9626 Tf 236.492 132.281 Td [(Duplicate)-315(co)-28(e\016cien)28(ts)-315(should)-315(b)-28(e)-315(o)28(v)28(erwritten)-315(\050i.e.)-438(ignore)-315(du-)]TJ -60.881 -11.955 Td [(plications\051)]TJ +0 g 0 G + 141.968 -29.888 Td [(16)]TJ +0 g 0 G +ET +endstream +endobj +738 0 obj << +/Type /Page +/Contents 739 0 R +/Resources 737 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 722 0 R +>> endobj +740 0 obj << +/D [738 0 R /XYZ 150.705 740.998 null] +>> endobj +716 0 obj << +/D [738 0 R /XYZ 206.371 201.167 null] +>> endobj +58 0 obj << +/D [738 0 R /XYZ 150.705 163.87 null] +>> endobj +737 0 obj << +/Font << /F30 611 0 R /F8 442 0 R /F27 441 0 R >> +/ProcSet [ /PDF /Text ] +>> endobj +747 0 obj << +/Length 8040 +>> +stream +0 g 0 G +0 g 0 G +0 g 0 G +BT +/F27 9.9626 Tf 99.895 706.129 Td [(psb)]TJ +ET +q +1 0 0 1 117.832 706.328 cm +[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S +Q +BT +/F27 9.9626 Tf 121.269 706.129 Td [(dupl)]TJ +ET +q +1 0 0 1 144.234 706.328 cm +[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S +Q +BT +/F27 9.9626 Tf 147.671 706.129 Td [(add)]TJ +ET +q +1 0 0 1 166.658 706.328 cm +[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S +Q +0 g 0 G +BT +/F8 9.9626 Tf 175.076 706.129 Td [(Duplicate)-333(co)-28(e\016cien)28(ts)-334(should)-333(b)-28(e)-333(added;)]TJ +0 g 0 G +/F27 9.9626 Tf -75.181 -21.522 Td [(psb)]TJ +ET +q +1 0 0 1 117.832 684.806 cm +[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S +Q +BT +/F27 9.9626 Tf 121.269 684.607 Td [(dupl)]TJ +ET +q +1 0 0 1 144.234 684.806 cm +[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S +Q +BT +/F27 9.9626 Tf 147.671 684.607 Td [(err)]TJ +ET +q +1 0 0 1 163.046 684.806 cm +[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S +Q +0 g 0 G +BT +/F8 9.9626 Tf 171.465 684.607 Td [(Duplicate)-333(co)-28(e\016cien)28(ts)-334(should)-333(trigger)-333(an)-334(error)-333(conditino)]TJ +0 g 0 G +/F27 9.9626 Tf -71.57 -21.522 Td [(psb)]TJ +ET +q +1 0 0 1 117.832 663.284 cm +[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S +Q +BT +/F27 9.9626 Tf 121.269 663.085 Td [(up)-32(d)]TJ +ET +q +1 0 0 1 141.37 663.284 cm +[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S +Q +BT +/F27 9.9626 Tf 144.807 663.085 Td [(d\015t)]TJ +ET +q +1 0 0 1 162.68 663.284 cm +[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S +Q +0 g 0 G +BT +/F8 9.9626 Tf 171.098 663.085 Td [(Default)-333(up)-28(date)-333(strategy)-334(for)-333(matrix)-333(co)-28(e\016cien)28(ts;)]TJ +0 g 0 G +/F27 9.9626 Tf -71.203 -21.522 Td [(psb)]TJ +ET +q +1 0 0 1 117.832 641.762 cm +[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S +Q +BT +/F27 9.9626 Tf 121.269 641.563 Td [(up)-32(d)]TJ +ET +q +1 0 0 1 141.37 641.762 cm +[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S +Q +BT +/F27 9.9626 Tf 144.807 641.563 Td [(src)32(h)]TJ +ET +q +1 0 0 1 165.87 641.762 cm +[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S +Q +0 g 0 G +BT +/F8 9.9626 Tf 174.289 641.563 Td [(Up)-28(date)-333(strategy)-333(based)-334(on)-333(searc)28(h)-334(in)28(to)-333(the)-334(d)1(ata)-334(structure;)]TJ +0 g 0 G +/F27 9.9626 Tf -74.394 -21.522 Td [(psb)]TJ +ET +q +1 0 0 1 117.832 620.24 cm +[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S +Q +BT +/F27 9.9626 Tf 121.269 620.041 Td [(up)-32(d)]TJ +ET +q +1 0 0 1 141.37 620.24 cm +[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S +Q +BT +/F27 9.9626 Tf 144.807 620.041 Td [(p)-32(erm)]TJ +ET +q +1 0 0 1 171.694 620.24 cm +[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S +Q +0 g 0 G +BT +/F8 9.9626 Tf 180.113 620.041 Td [(Up)-28(date)-398(strategy)-398(based)-398(on)-398(additional)-398(p)-28(erm)28(utation)-398(data)-398(\050se)-1(e)]TJ -55.311 -11.955 Td [(to)-28(ols)-333(routine)-333(description\051.)]TJ/F16 11.9552 Tf -24.907 -30.006 Td [(3.4)-1125(Preconditioner)-375(data)-375(structure)]TJ/F8 9.9626 Tf 0 -19.133 Td [(Our)-383(base)-383(library)-383(o\013ers)-383(supp)-28(ort)-383(for)-383(simple)-383(w)28(ell)-383(kno)27(wn)-383(preconditioners)-383(lik)28(e)-383(Di-)]TJ 0 -11.955 Td [(agonal)-333(Scaling)-334(or)-333(Blo)-28(c)28(k)-333(Jacobi)-334(with)-333(incomplete)-333(factorization)-334(ILU\0500\051.)]TJ 14.944 -12.354 Td [(A)-427(preconditioner)-428(is)-427(held)-428(in)-427(the)]TJ/F30 9.9626 Tf 142.723 0 Td [(psb)]TJ +ET +q +1 0 0 1 273.881 534.837 cm +[]0 d 0 J 0.398 w 0 0 m 3.138 0 l S +Q +BT +/F30 9.9626 Tf 277.019 534.638 Td [(prec)]TJ +ET +q +1 0 0 1 298.568 534.837 cm +[]0 d 0 J 0.398 w 0 0 m 3.138 0 l S +Q +BT +/F30 9.9626 Tf 301.707 534.638 Td [(type)]TJ/F8 9.9626 Tf 25.18 0 Td [(data)-427(structure)-428(rep)-28(orted)-427(in)]TJ -226.992 -11.955 Td [(\014gure)]TJ +0 0 1 rg 0 0 1 RG + [-361(6)]TJ +0 g 0 G + [(.)-527(The)]TJ/F30 9.9626 Tf 61.73 0 Td [(psb_prec_type)]TJ/F8 9.9626 Tf 71.589 0 Td [(data)-361(t)28(yp)-28(e)-361(ma)28(y)-361(con)28(tain)-361(a)-361(simple)-361(preconditioning)]TJ -133.319 -11.955 Td [(matrix)-395(w)-1(i)1(th)-396(the)-395(asso)-28(ciated)-396(comm)28(unication)-395(des)-1(crip)1(tor.The)-396(v)56(alues)-396(con)28(tained)-396(in)]TJ 0 -11.956 Td [(the)]TJ/F30 9.9626 Tf 16.637 0 Td [(iprcparm)]TJ/F8 9.9626 Tf 44.643 0 Td [(and)]TJ/F30 9.9626 Tf 18.85 0 Td [(rprcparm)]TJ/F8 9.9626 Tf 44.643 0 Td [(de\014ne)-281(tha)-281(t)28(yp)-28(e)-281(of)-281(preconditioner)-281(along)-281(with)-281(all)-281(the)]TJ -124.773 -11.955 Td [(parameters)-420(related)-421(to)-420(it;)-464(th)28(us,)]TJ/F30 9.9626 Tf 139.397 0 Td [(iprcparm)]TJ/F8 9.9626 Tf 46.03 0 Td [(and)]TJ/F30 9.9626 Tf 20.239 0 Td [(rprcparm)]TJ/F8 9.9626 Tf 46.03 0 Td [(de\014ne)-420(ho)27(w)-420(the)-420(other)]TJ -251.696 -11.955 Td [(records)-282(ha)28(v)28(e)-282(to)-282(b)-27(e)-282(in)28(terpreted.)-428(This)-281(data)-282(structure)-282(is)-282(the)-281(basis)-282(of)-282(more)-282(complex)]TJ 0 -11.955 Td [(preconditioning)-333(strategies,)-334(whic)28(h)-333(are)-333(the)-334(sub)-55(ject)-334(of)-333(further)-333(researc)27(h)1(.)]TJ/F16 11.9552 Tf 0 -30.006 Td [(3.5)-1125(Data)-375(structure)-375(query)-375(routines)]TJ/F27 9.9626 Tf 0 -19.133 Td [(get)]TJ +ET +q +1 0 0 1 116.018 413.968 cm +[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S +Q +BT +/F27 9.9626 Tf 119.455 413.768 Td [(lo)-32(cal)]TJ +ET +q +1 0 0 1 143.215 413.968 cm +[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S +Q +BT +/F27 9.9626 Tf 146.653 413.768 Td [(ro)32(ws)-383(|)-384(Get)-383(n)32(um)32(b)-32(er)-383(of)-384(lo)-32(cal)-383(ro)32(ws)]TJ +0 g 0 G +0 g 0 G +/F30 9.9626 Tf -46.758 -19.132 Td [(nr)-525(=)-525(desc%get_local_rows\050\051)]TJ +0 g 0 G +/F27 9.9626 Tf 0 -23.115 Td [(T)32(yp)-32(e:)]TJ 0 g 0 G /F8 9.9626 Tf 33.797 0 Td [(Async)28(hronous.)]TJ 0 g 0 G -/F27 9.9626 Tf -33.797 -24.78 Td [(On)-383(En)32(try)]TJ +/F27 9.9626 Tf -33.797 -21.522 Td [(On)-383(En)32(try)]TJ 0 g 0 G 0 g 0 G - 0 -24.78 Td [(desc)]TJ + 0 -21.522 Td [(desc)]TJ 0 g 0 G /F8 9.9626 Tf 26.209 0 Td [(the)-333(comm)27(unication)-333(descriptor.)]TJ -1.302 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf 23.073 0 Td [(.)]TJ -55.452 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf 41.898 0 Td [(.)]TJ -71.509 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(in)]TJ/F8 9.9626 Tf 9.547 0 Td [(.)]TJ -43.033 -11.956 Td [(Sp)-28(eci\014ed)-333(as:)-445(a)-333(structured)-333(data)-333(of)-334(t)28(yp)-28(e)]TJ 0 0 1 rg 0 0 1 RG /F30 9.9626 Tf 170.915 0 Td [(psb)]TJ ET q -1 0 0 1 312.036 525.571 cm +1 0 0 1 312.036 280.856 cm []0 d 0 J 0.398 w 0 0 m 3.138 0 l S Q BT -/F30 9.9626 Tf 315.174 525.372 Td [(desc)]TJ +/F30 9.9626 Tf 315.174 280.656 Td [(desc)]TJ ET q -1 0 0 1 336.723 525.571 cm +1 0 0 1 336.723 280.856 cm []0 d 0 J 0.398 w 0 0 m 3.138 0 l S Q BT -/F30 9.9626 Tf 339.861 525.372 Td [(type)]TJ +/F30 9.9626 Tf 339.861 280.656 Td [(type)]TJ 0 g 0 G /F8 9.9626 Tf 20.921 0 Td [(.)]TJ 0 g 0 G -/F27 9.9626 Tf -260.887 -25.559 Td [(On)-383(Return)]TJ +/F27 9.9626 Tf -260.887 -23.115 Td [(On)-383(Return)]TJ 0 g 0 G 0 g 0 G - 0 -24.78 Td [(F)96(unction)-384(v)64(alue)]TJ + 0 -21.522 Td [(F)96(unction)-384(v)64(alue)]TJ 0 g 0 G -/F8 9.9626 Tf 78.387 0 Td [(The)-333(comm)27(unication)-333(con)28(text.)]TJ/F27 9.9626 Tf -78.387 -32.335 Td [(psb)]TJ +/F8 9.9626 Tf 78.387 0 Td [(The)-460(n)28(um)27(b)-27(er)-461(of)-460(lo)-27(c)-1(al)-460(ro)28(ws,)-492(i.e.)-825(the)-460(n)28(um)27(b)-27(er)-460(of)-461(ro)28(ws)-460(o)28(wned)]TJ -53.48 -11.955 Td [(b)28(y)-401(the)-401(curren)27(t)-401(pro)-27(cess)-1(;)-435(as)-401(explained)-401(in)]TJ +0 0 1 rg 0 0 1 RG + [-401(1)]TJ +0 g 0 G + [(,)-418(it)-401(is)-401(equal)-401(to)]TJ/F14 9.9626 Tf 249.677 0 Td [(jI)]TJ/F10 6.9738 Tf 8.193 -1.494 Td [(i)]TJ/F14 9.9626 Tf 3.316 1.494 Td [(j)]TJ/F8 9.9626 Tf 5.432 0 Td [(+)]TJ/F14 9.9626 Tf 10.413 0 Td [(jB)]TJ/F10 6.9738 Tf 9.31 -1.494 Td [(i)]TJ/F14 9.9626 Tf 3.317 1.494 Td [(j)]TJ/F8 9.9626 Tf 2.768 0 Td [(.)-648(The)]TJ -292.426 -11.955 Td [(returned)-333(v)55(alue)-333(is)-333(sp)-28(eci\014c)-334(to)-333(the)-333(calling)-333(pro)-28(cess.)]TJ/F27 9.9626 Tf -24.907 -28.014 Td [(get)]TJ ET q -1 0 0 1 117.832 442.897 cm +1 0 0 1 116.018 184.294 cm []0 d 0 J 0.398 w 0 0 m 3.437 0 l S Q BT -/F27 9.9626 Tf 121.269 442.698 Td [(cd)]TJ +/F27 9.9626 Tf 119.455 184.095 Td [(lo)-32(cal)]TJ ET q -1 0 0 1 133.413 442.897 cm +1 0 0 1 143.215 184.294 cm []0 d 0 J 0.398 w 0 0 m 3.437 0 l S Q BT -/F27 9.9626 Tf 136.85 442.698 Td [(get)]TJ -ET -q -1 0 0 1 152.973 442.897 cm -[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S -Q -BT -/F27 9.9626 Tf 156.41 442.698 Td [(large)]TJ -ET -q -1 0 0 1 181.547 442.897 cm -[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S -Q -BT -/F27 9.9626 Tf 184.984 442.698 Td [(threshold)-268(|)-268(Get)-268(threshold)-269(for)-268(index)-268(mapping)-268(switc)32(h)]TJ +/F27 9.9626 Tf 146.653 184.095 Td [(cols)-383(|)-384(Get)-383(n)32(um)32(b)-32(er)-383(of)-384(lo)-32(cal)-383(cols)]TJ 0 g 0 G 0 g 0 G -/F30 9.9626 Tf -85.089 -20.648 Td [(ith)-525(=)-525(psb_cd_get_large_threshold\050\051)]TJ +/F30 9.9626 Tf -46.758 -19.132 Td [(nc)-525(=)-525(desc%get_local_cols\050\051)]TJ 0 g 0 G -/F27 9.9626 Tf 0 -25.559 Td [(T)32(yp)-32(e:)]TJ +/F27 9.9626 Tf 0 -23.115 Td [(On)-383(En)32(try)]TJ +0 g 0 G +0 g 0 G + 0 -21.522 Td [(T)32(yp)-32(e:)]TJ 0 g 0 G /F8 9.9626 Tf 33.797 0 Td [(Async)28(hronous.)]TJ 0 g 0 G -/F27 9.9626 Tf -33.797 -24.78 Td [(On)-383(Return)]TJ -0 g 0 G -0 g 0 G - 0 -24.78 Td [(F)96(unction)-384(v)64(alue)]TJ -0 g 0 G -/F8 9.9626 Tf 78.387 0 Td [(The)-333(curren)28(t)-334(v)56(alue)-334(for)-333(the)-333(size)-334(threshold.)]TJ/F27 9.9626 Tf -78.387 -32.335 Td [(psb)]TJ -ET -q -1 0 0 1 117.832 314.795 cm -[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S -Q -BT -/F27 9.9626 Tf 121.269 314.596 Td [(cd)]TJ -ET -q -1 0 0 1 133.413 314.795 cm -[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S -Q -BT -/F27 9.9626 Tf 136.85 314.596 Td [(set)]TJ -ET -q -1 0 0 1 151.764 314.795 cm -[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S -Q -BT -/F27 9.9626 Tf 155.201 314.596 Td [(large)]TJ -ET -q -1 0 0 1 180.338 314.795 cm -[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S -Q -BT -/F27 9.9626 Tf 183.775 314.596 Td [(threshold)-323(|)-324(Set)-323(threshold)-324(for)-323(index)-323(mapping)-324(switc)32(h)]TJ -0 g 0 G -0 g 0 G -/F30 9.9626 Tf -83.88 -20.648 Td [(call)-525(psb_cd_set_large_threshold\050ith\051)]TJ -0 g 0 G -/F27 9.9626 Tf 0 -25.559 Td [(T)32(yp)-32(e:)]TJ -0 g 0 G -/F8 9.9626 Tf 33.797 0 Td [(Async)28(hronous.)]TJ -0 g 0 G -/F27 9.9626 Tf -33.797 -24.78 Td [(On)-383(En)32(try)]TJ -0 g 0 G -0 g 0 G - 0 -24.78 Td [(ith)]TJ -0 g 0 G -/F8 9.9626 Tf 18.985 0 Td [(the)-333(new)-334(threshold)-333(for)-333(comm)27(u)1(nication)-334(descriptors.)]TJ 5.922 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(global)]TJ/F8 9.9626 Tf 29.756 0 Td [(.)]TJ -62.135 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf 41.898 0 Td [(.)]TJ -71.509 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(in)]TJ/F8 9.9626 Tf 9.547 0 Td [(.)]TJ -43.033 -11.956 Td [(Sp)-28(eci\014ed)-333(as:)-445(an)-333(in)28(teger)-333(v)55(alue)-333(greater)-333(than)-334(zero.)]TJ -24.907 -26.772 Td [(Note:)-756(the)-490(threshold)-489(v)56(alue)-489(is)-490(only)-489(queried)-489(b)28(y)-490(th)1(e)-490(library)-489(at)-489(the)-489(time)-490(a)-489(call)]TJ 0 -11.955 Td [(to)]TJ/F30 9.9626 Tf 13.431 0 Td [(psb_cdall)]TJ/F8 9.9626 Tf 51.649 0 Td [(is)-459(executed,)-491(therefore)-459(c)27(hangi)1(ng)-460(the)-459(threshold)-459(has)-459(no)-460(e\013ect)-459(on)]TJ -65.08 -11.955 Td [(comm)28(unication)-334(descriptors)-333(that)-333(ha)28(v)27(e)-333(already)-333(b)-28(een)-333(initialized.)]TJ -0 g 0 G - 166.875 -29.888 Td [(17)]TJ + 133.078 -29.888 Td [(17)]TJ 0 g 0 G ET endstream endobj -737 0 obj << +746 0 obj << /Type /Page -/Contents 738 0 R -/Resources 736 0 R +/Contents 747 0 R +/Resources 745 0 R /MediaBox [0 0 595.276 841.89] -/Parent 711 0 R -/Annots [ 730 0 R ] ->> endobj -730 0 obj << -/Type /Annot -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [294.721 522.161 361.779 533.286] -/Subtype /Link -/A << /S /GoTo /D (descdata) >> ->> endobj -739 0 obj << -/D [737 0 R /XYZ 99.895 740.998 null] ->> endobj -78 0 obj << -/D [737 0 R /XYZ 99.895 659.155 null] ->> endobj -82 0 obj << -/D [737 0 R /XYZ 99.895 433.281 null] ->> endobj -86 0 obj << -/D [737 0 R /XYZ 99.895 305.179 null] ->> endobj -736 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F27 433 0 R /F8 434 0 R >> -/ProcSet [ /PDF /Text ] ->> endobj -744 0 obj << -/Length 6012 ->> -stream -0 g 0 G -0 g 0 G -BT -/F27 9.9626 Tf 150.705 706.129 Td [(psb)]TJ -ET -q -1 0 0 1 168.641 706.328 cm -[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S -Q -BT -/F27 9.9626 Tf 172.078 706.129 Td [(sp)]TJ -ET -q -1 0 0 1 183.65 706.328 cm -[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S -Q -BT -/F27 9.9626 Tf 187.087 706.129 Td [(get)]TJ -ET -q -1 0 0 1 203.21 706.328 cm -[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S -Q -BT -/F27 9.9626 Tf 206.647 706.129 Td [(nro)32(ws)-383(|)-384(Get)-383(n)32(um)32(b)-32(er)-383(of)-384(ro)32(ws)-383(in)-383(a)-384(sparse)-383(matrix)]TJ -0 g 0 G -0 g 0 G -/F30 9.9626 Tf -55.942 -18.389 Td [(nr)-525(=)-525(psb_sp_get_nrows\050a\051)]TJ -0 g 0 G -/F27 9.9626 Tf 0 -21.066 Td [(T)32(yp)-32(e:)]TJ -0 g 0 G -/F8 9.9626 Tf 33.797 0 Td [(Async)28(hronous.)]TJ -0 g 0 G -/F27 9.9626 Tf -33.797 -19.585 Td [(On)-383(En)32(try)]TJ -0 g 0 G -0 g 0 G - 0 -19.584 Td [(a)]TJ -0 g 0 G -/F8 9.9626 Tf 10.551 0 Td [(the)-333(sparse)-334(matrix)]TJ 14.356 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.378 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.378 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf -29.611 -11.956 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.485 0 Td [(in)]TJ/F8 9.9626 Tf 9.548 0 Td [(.)]TJ -43.033 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-444(a)-334(structured)-333(data)-333(of)-334(t)28(yp)-28(e)]TJ -0 0 1 rg 0 0 1 RG -/F30 9.9626 Tf 170.914 0 Td [(psb)]TJ -ET -q -1 0 0 1 362.845 579.884 cm -[]0 d 0 J 0.398 w 0 0 m 3.138 0 l S -Q -BT -/F30 9.9626 Tf 365.983 579.684 Td [(spmat)]TJ -ET -q -1 0 0 1 392.763 579.884 cm -[]0 d 0 J 0.398 w 0 0 m 3.138 0 l S -Q -BT -/F30 9.9626 Tf 395.901 579.684 Td [(type)]TJ -0 g 0 G -/F8 9.9626 Tf 20.921 0 Td [(.)]TJ -0 g 0 G -/F27 9.9626 Tf -266.117 -21.065 Td [(On)-383(Return)]TJ -0 g 0 G -0 g 0 G - 0 -19.585 Td [(F)96(unction)-384(v)64(alue)]TJ -0 g 0 G -/F8 9.9626 Tf 78.386 0 Td [(The)-333(n)27(um)28(b)-28(er)-333(of)-333(ro)28(ws)-334(of)-333(sparse)-333(matrix)]TJ/F30 9.9626 Tf 164.937 0 Td [(a)]TJ/F8 9.9626 Tf 5.231 0 Td [(.)]TJ/F27 9.9626 Tf -248.554 -25.749 Td [(psb)]TJ -ET -q -1 0 0 1 168.641 513.484 cm -[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S -Q -BT -/F27 9.9626 Tf 172.078 513.285 Td [(sp)]TJ -ET -q -1 0 0 1 183.65 513.484 cm -[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S -Q -BT -/F27 9.9626 Tf 187.087 513.285 Td [(get)]TJ -ET -q -1 0 0 1 203.21 513.484 cm -[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S -Q -BT -/F27 9.9626 Tf 206.647 513.285 Td [(ncols)-383(|)-384(Get)-383(n)32(um)32(b)-32(er)-383(of)-384(columns)-383(in)-383(a)-384(sparse)-383(matrix)]TJ -0 g 0 G -0 g 0 G -/F30 9.9626 Tf -55.942 -18.389 Td [(nr)-525(=)-525(psb_sp_get_ncols\050a\051)]TJ -0 g 0 G -/F27 9.9626 Tf 0 -21.066 Td [(T)32(yp)-32(e:)]TJ -0 g 0 G -/F8 9.9626 Tf 33.797 0 Td [(Async)28(hronous.)]TJ -0 g 0 G -/F27 9.9626 Tf -33.797 -19.584 Td [(On)-383(En)32(try)]TJ -0 g 0 G -0 g 0 G - 0 -19.585 Td [(a)]TJ -0 g 0 G -/F8 9.9626 Tf 10.551 0 Td [(the)-333(sparse)-334(matrix)]TJ 14.356 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.378 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.378 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf -29.611 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.485 0 Td [(in)]TJ/F8 9.9626 Tf 9.548 0 Td [(.)]TJ -43.033 -11.956 Td [(Sp)-28(eci\014ed)-333(as:)-444(a)-334(structured)-333(data)-333(of)-334(t)28(yp)-28(e)]TJ -0 0 1 rg 0 0 1 RG -/F30 9.9626 Tf 170.914 0 Td [(psb)]TJ -ET -q -1 0 0 1 362.845 387.04 cm -[]0 d 0 J 0.398 w 0 0 m 3.138 0 l S -Q -BT -/F30 9.9626 Tf 365.983 386.84 Td [(spmat)]TJ -ET -q -1 0 0 1 392.763 387.04 cm -[]0 d 0 J 0.398 w 0 0 m 3.138 0 l S -Q -BT -/F30 9.9626 Tf 395.901 386.84 Td [(type)]TJ -0 g 0 G -/F8 9.9626 Tf 20.921 0 Td [(.)]TJ -0 g 0 G -/F27 9.9626 Tf -266.117 -21.065 Td [(On)-383(Return)]TJ -0 g 0 G -0 g 0 G - 0 -19.585 Td [(F)96(unction)-384(v)64(alue)]TJ -0 g 0 G -/F8 9.9626 Tf 78.386 0 Td [(The)-333(n)27(um)28(b)-28(er)-333(of)-333(columns)-334(of)-333(sparse)-333(matrix)]TJ/F30 9.9626 Tf 180.684 0 Td [(a)]TJ/F8 9.9626 Tf 5.23 0 Td [(.)]TJ/F27 9.9626 Tf -264.3 -25.749 Td [(psb)]TJ -ET -q -1 0 0 1 168.641 320.64 cm -[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S -Q -BT -/F27 9.9626 Tf 172.078 320.441 Td [(sp)]TJ -ET -q -1 0 0 1 183.65 320.64 cm -[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S -Q -BT -/F27 9.9626 Tf 187.087 320.441 Td [(get)]TJ -ET -q -1 0 0 1 203.21 320.64 cm -[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S -Q -BT -/F27 9.9626 Tf 206.647 320.441 Td [(nnzeros)-482(|)-482(Get)-482(n)32(um)32(b)-32(er)-482(of)-482(nonzero)-482(elemen)32(ts)-482(i)-1(n)-482(a)-482(sparse)]TJ -55.942 -11.955 Td [(matrix)]TJ -0 g 0 G -0 g 0 G -/F30 9.9626 Tf 0 -18.389 Td [(nr)-525(=)-525(psb_sp_get_nnzeros\050a\051)]TJ -0 g 0 G -/F27 9.9626 Tf 0 -21.066 Td [(T)32(yp)-32(e:)]TJ -0 g 0 G -/F8 9.9626 Tf 33.797 0 Td [(Async)28(hronous.)]TJ -0 g 0 G -/F27 9.9626 Tf -33.797 -19.584 Td [(On)-383(En)32(try)]TJ -0 g 0 G -0 g 0 G - 0 -19.585 Td [(a)]TJ -0 g 0 G -/F8 9.9626 Tf 10.551 0 Td [(the)-333(sparse)-334(matrix)]TJ 14.356 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.378 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.378 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf -29.611 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.485 0 Td [(in)]TJ/F8 9.9626 Tf 9.548 0 Td [(.)]TJ -43.033 -11.956 Td [(Sp)-28(eci\014ed)-333(as:)-444(a)-334(structured)-333(data)-333(of)-334(t)28(yp)-28(e)]TJ -0 0 1 rg 0 0 1 RG -/F30 9.9626 Tf 170.914 0 Td [(psb)]TJ -ET -q -1 0 0 1 362.845 182.241 cm -[]0 d 0 J 0.398 w 0 0 m 3.138 0 l S -Q -BT -/F30 9.9626 Tf 365.983 182.041 Td [(spmat)]TJ -ET -q -1 0 0 1 392.763 182.241 cm -[]0 d 0 J 0.398 w 0 0 m 3.138 0 l S -Q -BT -/F30 9.9626 Tf 395.901 182.041 Td [(type)]TJ -0 g 0 G -/F8 9.9626 Tf 20.921 0 Td [(.)]TJ -0 g 0 G -/F27 9.9626 Tf -266.117 -21.065 Td [(On)-383(Return)]TJ -0 g 0 G -0 g 0 G - 0 -19.585 Td [(F)96(unction)-384(v)64(alue)]TJ -0 g 0 G -/F8 9.9626 Tf 78.386 0 Td [(The)-333(n)27(um)28(b)-28(er)-333(of)-333(nonzero)-333(e)-1(l)1(e)-1(men)28(ts)-333(stored)-334(i)1(n)-334(sparse)-333(matrix)]TJ/F30 9.9626 Tf 249.98 0 Td [(a)]TJ/F8 9.9626 Tf 5.23 0 Td [(.)]TJ/F27 9.9626 Tf -333.596 -21.065 Td [(Notes)]TJ -0 g 0 G -/F8 9.9626 Tf 166.874 -29.888 Td [(18)]TJ -0 g 0 G -ET -endstream -endobj -743 0 obj << -/Type /Page -/Contents 744 0 R -/Resources 742 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 711 0 R -/Annots [ 735 0 R 740 0 R 741 0 R ] ->> endobj -735 0 obj << -/Type /Annot -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [345.53 576.474 417.818 587.599] -/Subtype /Link -/A << /S /GoTo /D (spdata) >> ->> endobj -740 0 obj << -/Type /Annot -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [345.53 383.63 417.818 394.755] -/Subtype /Link -/A << /S /GoTo /D (spdata) >> +/Parent 722 0 R +/Annots [ 741 0 R 742 0 R 743 0 R ] >> endobj 741 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] -/Rect [345.53 178.831 417.818 189.956] +/Rect [126.875 519.473 133.849 530.598] /Subtype /Link -/A << /S /GoTo /D (spdata) >> ->> endobj -745 0 obj << -/D [743 0 R /XYZ 150.705 740.998 null] ->> endobj -90 0 obj << -/D [743 0 R /XYZ 150.705 697.758 null] ->> endobj -94 0 obj << -/D [743 0 R /XYZ 150.705 504.914 null] ->> endobj -98 0 obj << -/D [743 0 R /XYZ 150.705 302.052 null] +/A << /S /GoTo /D (figure.6) >> >> endobj 742 0 obj << -/Font << /F27 433 0 R /F30 601 0 R /F8 434 0 R >> -/ProcSet [ /PDF /Text ] +/Type /Annot +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [294.721 277.446 361.779 288.571] +/Subtype /Link +/A << /S /GoTo /D (descdata) >> +>> endobj +743 0 obj << +/Type /Annot +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [300.421 220.577 307.395 232.532] +/Subtype /Link +/A << /S /GoTo /D (section.1) >> >> endobj 748 0 obj << -/Length 631 ->> -stream -0 g 0 G -0 g 0 G -0 g 0 G -BT -/F8 9.9626 Tf 112.072 706.129 Td [(1.)]TJ -0 g 0 G - [-500(The)-462(function)-462(v)55(alue)-462(is)-462(sp)-28(eci\014c)-462(to)-462(the)-463(storage)-462(format)-462(of)-462(matrix)]TJ/F30 9.9626 Tf 296.649 0 Td [(a)]TJ/F8 9.9626 Tf 5.23 0 Td [(;)-527(some)]TJ -289.149 -11.955 Td [(storage)-465(formats)-466(emplo)28(y)-465(padding,)-498(th)27(u)1(s)-466(the)-465(returned)-465(v)55(alue)-465(for)-465(the)-466(same)]TJ 0 -11.955 Td [(matrix)-333(ma)27(y)-333(b)-28(e)-333(di\013eren)28(t)-334(for)-333(di\013eren)28(t)-333(storage)-334(c)28(hoices.)]TJ -0 g 0 G - 141.968 -591.781 Td [(19)]TJ -0 g 0 G -ET -endstream -endobj -747 0 obj << -/Type /Page -/Contents 748 0 R -/Resources 746 0 R -/MediaBox [0 0 595.276 841.89] -/Parent 751 0 R +/D [746 0 R /XYZ 99.895 740.998 null] +>> endobj +62 0 obj << +/D [746 0 R /XYZ 99.895 589.936 null] >> endobj 749 0 obj << -/D [747 0 R /XYZ 99.895 740.998 null] +/D [746 0 R /XYZ 257.563 534.638 null] >> endobj -750 0 obj << -/D [747 0 R /XYZ 99.895 716.092 null] +66 0 obj << +/D [746 0 R /XYZ 99.895 445.31 null] >> endobj -746 0 obj << -/Font << /F8 434 0 R /F30 601 0 R >> +70 0 obj << +/D [746 0 R /XYZ 99.895 405.053 null] +>> endobj +74 0 obj << +/D [746 0 R /XYZ 99.895 175.38 null] +>> endobj +745 0 obj << +/Font << /F27 441 0 R /F8 442 0 R /F16 439 0 R /F30 611 0 R /F14 614 0 R /F10 613 0 R >> /ProcSet [ /PDF /Text ] >> endobj 754 0 obj << -/Length 158 +/Length 4322 >> stream 0 g 0 G 0 g 0 G -BT -/F16 14.3462 Tf 150.705 706.129 Td [(4)-1125(Computational)-375(routines)]TJ 0 g 0 G -/F8 9.9626 Tf 166.874 -615.691 Td [(20)]TJ +0 g 0 G +0 g 0 G +q +1 0 0 1 157.987 705.93 cm +[]0 d 0 J 0.398 w 0 0 m 329.147 0 l S +Q +q +1 0 0 1 158.186 251.434 cm +[]0 d 0 J 0.398 w 0 0 m 0 454.296 l S +Q +0 g 0 G +0 g 0 G +BT +/F46 8.9664 Tf 175.77 686.801 Td [(type)-525(psb_sprec_type)]TJ 9.415 -10.959 Td [(type\050psb_sspmat_type\051,)-525(allocatable)-525(::)-525(av\050:\051)]TJ 0 -10.958 Td [(real\050psb_spk_\051,)-525(allocatable)-4200(::)-525(d\050:\051)]TJ 0 -10.959 Td [(type\050psb_desc_type\051)-8400(::)-525(desc_data)]TJ 0 -10.959 Td [(integer,)-525(allocatable)-7875(::)-525(iprcparm\050:\051)]TJ 0 -10.959 Td [(real\050psb_spk_\051,)-525(allocatable)-4200(::)-525(rprcparm\050:\051)]TJ 0 -10.959 Td [(integer,)-525(allocatable)-7875(::)-525(perm\050:\051,)-1050(invperm\050:\051)]TJ 0 -10.959 Td [(integer)-14700(::)-525(prec,)-525(base_prec)]TJ -9.415 -10.959 Td [(end)-525(type)-525(psb_sprec_type)]TJ 0 -21.918 Td [(type)-525(psb_dprec_type)]TJ 9.415 -10.959 Td [(type\050psb_dspmat_type\051,)-525(allocatable)-525(::)-525(av\050:\051)]TJ 0 -10.958 Td [(real\050psb_dpk_\051,)-525(allocatable)-4200(::)-525(d\050:\051)]TJ 0 -10.959 Td [(type\050psb_desc_type\051)-8400(::)-525(desc_data)]TJ 0 -10.959 Td [(integer,)-525(allocatable)-7875(::)-525(iprcparm\050:\051)]TJ 0 -10.959 Td [(real\050psb_dpk_\051,)-525(allocatable)-4200(::)-525(rprcparm\050:\051)]TJ 0 -10.959 Td [(integer,)-525(allocatable)-7875(::)-525(perm\050:\051,)-1050(invperm\050:\051)]TJ 0 -10.959 Td [(integer)-14700(::)-525(prec,)-525(base_prec)]TJ -9.415 -10.959 Td [(end)-525(type)-525(psb_dprec_type)]TJ 0 -21.918 Td [(type)-525(psb_cprec_type)]TJ 9.415 -10.959 Td [(type\050psb_cspmat_type\051,)-525(allocatable)-525(::)-525(av\050:\051)]TJ 0 -10.958 Td [(complex\050psb_spk_\051,)-525(allocatable)-2625(::)-525(d\050:\051)]TJ 0 -10.959 Td [(type\050psb_desc_type\051)-8400(::)-525(desc_data)]TJ 0 -10.959 Td [(integer,)-525(allocatable)-7875(::)-525(iprcparm\050:\051)]TJ 0 -10.959 Td [(real\050psb_spk_\051,)-525(allocatable)-4200(::)-525(rprcparm\050:\051)]TJ 0 -10.959 Td [(integer,)-525(allocatable)-7875(::)-525(perm\050:\051,)-1050(invperm\050:\051)]TJ 0 -10.959 Td [(integer)-14700(::)-525(prec,)-525(base_prec)]TJ -9.415 -10.959 Td [(end)-525(type)-525(psb_cprec_type)]TJ 0 -21.918 Td [(type)-525(psb_zprec_type)]TJ 9.415 -10.959 Td [(type\050psb_zspmat_type\051,)-525(allocatable)-525(::)-525(av\050:\051)]TJ 0 -10.959 Td [(complex\050psb_dpk_\051,)-525(allocatable)-2625(::)-525(d\050:\051)]TJ 0 -10.958 Td [(type\050psb_desc_type\051)-8400(::)-525(desc_data)]TJ 0 -10.959 Td [(integer,)-525(allocatable)-7875(::)-525(iprcparm\050:\051)]TJ 0 -10.959 Td [(real\050psb_dpk_\051,)-525(allocatable)-4200(::)-525(rprcparm\050:\051)]TJ 0 -10.959 Td [(integer,)-525(allocatable)-7875(::)-525(perm\050:\051,)-1050(invperm\050:\051)]TJ 0 -10.959 Td [(integer)-14700(::)-525(prec,)-525(base_prec)]TJ -9.415 -10.959 Td [(end)-525(type)-525(psb_zprec_type)]TJ +ET +q +1 0 0 1 486.935 251.434 cm +[]0 d 0 J 0.398 w 0 0 m 0 454.296 l S +Q +q +1 0 0 1 157.987 251.235 cm +[]0 d 0 J 0.398 w 0 0 m 329.147 0 l S +Q +0 g 0 G +BT +/F8 9.9626 Tf 162.674 223.195 Td [(Figure)-333(6:)-445(The)-333(PSBLAS)-333(de\014ned)-334(d)1(a)-1(t)1(a)-334(t)28(yp)-28(e)-333(that)-333(con)27(tains)-333(a)-333(preconditioner.)]TJ +0 g 0 G +0 g 0 G +0 g 0 G +/F27 9.9626 Tf -11.969 -32.347 Td [(desc)]TJ +0 g 0 G +/F8 9.9626 Tf 26.208 0 Td [(the)-333(comm)27(unication)-333(descriptor.)]TJ -1.302 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf 23.073 0 Td [(.)]TJ -55.452 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.612 0 Td [(required)]TJ/F8 9.9626 Tf 41.898 0 Td [(.)]TJ -71.51 -11.956 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(in)]TJ/F8 9.9626 Tf 9.547 0 Td [(.)]TJ -43.033 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-445(a)-333(structured)-333(data)-333(of)-334(t)28(yp)-28(e)]TJ +0 0 1 rg 0 0 1 RG +/F30 9.9626 Tf 170.915 0 Td [(psb)]TJ +ET +q +1 0 0 1 362.845 143.226 cm +[]0 d 0 J 0.398 w 0 0 m 3.138 0 l S +Q +BT +/F30 9.9626 Tf 365.983 143.027 Td [(desc)]TJ +ET +q +1 0 0 1 387.532 143.226 cm +[]0 d 0 J 0.398 w 0 0 m 3.138 0 l S +Q +BT +/F30 9.9626 Tf 390.67 143.027 Td [(type)]TJ +0 g 0 G +/F8 9.9626 Tf 20.922 0 Td [(.)]TJ +0 g 0 G +/F27 9.9626 Tf -260.887 -22.701 Td [(On)-383(Return)]TJ +0 g 0 G +0 g 0 G +/F8 9.9626 Tf 166.874 -29.888 Td [(18)]TJ 0 g 0 G ET endstream @@ -5958,19 +5594,608 @@ endobj /Contents 754 0 R /Resources 752 0 R /MediaBox [0 0 595.276 841.89] -/Parent 751 0 R +/Parent 722 0 R +/Annots [ 744 0 R ] +>> endobj +744 0 obj << +/Type /Annot +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [345.53 139.817 412.588 150.942] +/Subtype /Link +/A << /S /GoTo /D (descdata) >> >> endobj 755 0 obj << /D [753 0 R /XYZ 150.705 740.998 null] >> endobj -102 0 obj << -/D [753 0 R /XYZ 150.705 716.092 null] +750 0 obj << +/D [753 0 R /XYZ 206.288 235.151 null] >> endobj 752 0 obj << -/Font << /F16 431 0 R /F8 434 0 R >> +/Font << /F46 756 0 R /F8 442 0 R /F27 441 0 R /F30 611 0 R >> /ProcSet [ /PDF /Text ] >> endobj -764 0 obj << +762 0 obj << +/Length 6214 +>> +stream +0 g 0 G +0 g 0 G +0 g 0 G +BT +/F27 9.9626 Tf 99.895 706.129 Td [(F)96(unction)-384(v)64(alue)]TJ +0 g 0 G +/F8 9.9626 Tf 78.387 0 Td [(The)-360(n)27(um)28(b)-28(er)-360(of)-361(lo)-27(cal)-361(cols,)-367(i.e.)-526(the)-361(n)28(um)28(b)-28(er)-360(of)-361(ind)1(ic)-1(es)-360(used)-361(b)28(y)]TJ -53.48 -11.955 Td [(the)-421(curren)28(t)-421(pro)-28(cess,)-443(including)-420(b)-28(oth)-421(lo)-28(cal)-421(and)-421(halo)-421(i)1(ndices)-1(;)-464(as)-421(explained)]TJ 0 -11.955 Td [(in)]TJ +0 0 1 rg 0 0 1 RG + [-343(1)]TJ +0 g 0 G + [(,)-347(it)-343(is)-344(equal)-343(to)]TJ/F14 9.9626 Tf 81.777 0 Td [(jI)]TJ/F10 6.9738 Tf 8.192 -1.495 Td [(i)]TJ/F14 9.9626 Tf 3.317 1.495 Td [(j)]TJ/F8 9.9626 Tf 5.049 0 Td [(+)]TJ/F14 9.9626 Tf 10.03 0 Td [(jB)]TJ/F10 6.9738 Tf 9.311 -1.495 Td [(i)]TJ/F14 9.9626 Tf 3.317 1.495 Td [(j)]TJ/F8 9.9626 Tf 5.049 0 Td [(+)]TJ/F14 9.9626 Tf 10.031 0 Td [(jH)]TJ/F10 6.9738 Tf 11.181 -1.495 Td [(i)]TJ/F14 9.9626 Tf 3.317 1.495 Td [(j)]TJ/F8 9.9626 Tf 2.767 0 Td [(.)-475(The)-344(returned)-343(v)55(alue)-343(is)-344(sp)-27(e)-1(ci\014c)-343(to)-344(the)]TJ -153.338 -11.956 Td [(calling)-333(pro)-28(cess.)]TJ/F27 9.9626 Tf -24.907 -25.441 Td [(get)]TJ +ET +q +1 0 0 1 116.018 645.022 cm +[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S +Q +BT +/F27 9.9626 Tf 119.455 644.822 Td [(global)]TJ +ET +q +1 0 0 1 149.899 645.022 cm +[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S +Q +BT +/F27 9.9626 Tf 153.336 644.822 Td [(ro)32(ws)-383(|)-384(Get)-383(n)32(um)32(b)-32(er)-383(of)-384(global)-383(ro)32(ws)]TJ +0 g 0 G +0 g 0 G +/F30 9.9626 Tf -53.441 -18.389 Td [(nr)-525(=)-525(desc%get_global_rows\050\051)]TJ +0 g 0 G +/F27 9.9626 Tf 0 -19.276 Td [(On)-383(En)32(try)]TJ +0 g 0 G +0 g 0 G + 0 -18.869 Td [(T)32(yp)-32(e:)]TJ +0 g 0 G +/F8 9.9626 Tf 33.797 0 Td [(Async)28(hronous.)]TJ +0 g 0 G +/F27 9.9626 Tf -33.797 -18.869 Td [(desc)]TJ +0 g 0 G +/F8 9.9626 Tf 26.209 0 Td [(the)-333(comm)27(unication)-333(descriptor.)]TJ -1.302 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf 23.073 0 Td [(.)]TJ -55.452 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf 41.898 0 Td [(.)]TJ -71.509 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(in)]TJ/F8 9.9626 Tf 9.547 0 Td [(.)]TJ -43.033 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-445(a)-333(structured)-333(data)-333(of)-334(t)28(yp)-28(e)]TJ +0 0 1 rg 0 0 1 RG +/F30 9.9626 Tf 170.915 0 Td [(psb)]TJ +ET +q +1 0 0 1 312.036 521.798 cm +[]0 d 0 J 0.398 w 0 0 m 3.138 0 l S +Q +BT +/F30 9.9626 Tf 315.174 521.599 Td [(desc)]TJ +ET +q +1 0 0 1 336.723 521.798 cm +[]0 d 0 J 0.398 w 0 0 m 3.138 0 l S +Q +BT +/F30 9.9626 Tf 339.861 521.599 Td [(type)]TJ +0 g 0 G +/F8 9.9626 Tf 20.921 0 Td [(.)]TJ +0 g 0 G +/F27 9.9626 Tf -260.887 -19.277 Td [(On)-383(Return)]TJ +0 g 0 G +0 g 0 G + 0 -18.868 Td [(F)96(unction)-384(v)64(alue)]TJ +0 g 0 G +/F8 9.9626 Tf 78.387 0 Td [(The)-333(n)27(u)1(m)27(b)-27(e)-1(r)-333(of)-333(global)-333(ro)27(ws)-333(in)-333(the)-334(mesh)]TJ/F27 9.9626 Tf -78.387 -25.441 Td [(get)]TJ +ET +q +1 0 0 1 116.018 458.212 cm +[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S +Q +BT +/F27 9.9626 Tf 119.455 458.013 Td [(global)]TJ +ET +q +1 0 0 1 149.899 458.212 cm +[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S +Q +BT +/F27 9.9626 Tf 153.336 458.013 Td [(cols)-383(|)-384(Get)-383(n)32(um)32(b)-32(er)-383(of)-384(global)-383(cols)]TJ +0 g 0 G +0 g 0 G +/F30 9.9626 Tf -53.441 -18.39 Td [(nr)-525(=)-525(desc%get_global_cols\050\051)]TJ +0 g 0 G +/F27 9.9626 Tf 0 -19.276 Td [(T)32(yp)-32(e:)]TJ +0 g 0 G +/F8 9.9626 Tf 33.797 0 Td [(Async)28(hronous.)]TJ +0 g 0 G +/F27 9.9626 Tf -33.797 -18.868 Td [(On)-383(En)32(try)]TJ +0 g 0 G +0 g 0 G + 0 -18.869 Td [(desc)]TJ +0 g 0 G +/F8 9.9626 Tf 26.209 0 Td [(the)-333(comm)27(unication)-333(descriptor.)]TJ -1.302 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf 23.073 0 Td [(.)]TJ -55.452 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf 41.898 0 Td [(.)]TJ -71.509 -11.956 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(in)]TJ/F8 9.9626 Tf 9.547 0 Td [(.)]TJ -43.033 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-445(a)-333(structured)-333(data)-333(of)-334(t)28(yp)-28(e)]TJ +0 0 1 rg 0 0 1 RG +/F30 9.9626 Tf 170.915 0 Td [(psb)]TJ +ET +q +1 0 0 1 312.036 334.988 cm +[]0 d 0 J 0.398 w 0 0 m 3.138 0 l S +Q +BT +/F30 9.9626 Tf 315.174 334.789 Td [(desc)]TJ +ET +q +1 0 0 1 336.723 334.988 cm +[]0 d 0 J 0.398 w 0 0 m 3.138 0 l S +Q +BT +/F30 9.9626 Tf 339.861 334.789 Td [(type)]TJ +0 g 0 G +/F8 9.9626 Tf 20.921 0 Td [(.)]TJ +0 g 0 G +/F27 9.9626 Tf -260.887 -19.276 Td [(On)-383(Return)]TJ +0 g 0 G +0 g 0 G + 0 -18.869 Td [(F)96(unction)-384(v)64(alue)]TJ +0 g 0 G +/F8 9.9626 Tf 78.387 0 Td [(The)-333(n)27(u)1(m)27(b)-27(e)-1(r)-333(of)-333(global)-333(cols)-334(in)-333(the)-333(mes)-1(h)]TJ +0 g 0 G +0 g 0 G +/F16 11.9552 Tf -78.387 -47.238 Td [(get)]TJ +ET +q +1 0 0 1 118.794 249.605 cm +[]0 d 0 J 0.398 w 0 0 m 4.035 0 l S +Q +BT +/F16 11.9552 Tf 122.829 249.406 Td [(con)31(text|Get)-375(comm)31(unica)1(tion)-375(con)31(text)]TJ +0 g 0 G +0 g 0 G +/F30 9.9626 Tf -22.934 -24.246 Td [(ictxt)-525(=)-525(desc%get_context\050\051)]TJ +0 g 0 G +/F27 9.9626 Tf 0 -19.276 Td [(T)32(yp)-32(e:)]TJ +0 g 0 G +/F8 9.9626 Tf 33.797 0 Td [(Async)28(hronous.)]TJ +0 g 0 G +/F27 9.9626 Tf -33.797 -18.869 Td [(On)-383(En)32(try)]TJ +0 g 0 G +0 g 0 G + 0 -18.869 Td [(desc)]TJ +0 g 0 G +/F8 9.9626 Tf 26.209 0 Td [(the)-333(comm)27(unication)-333(descriptor.)]TJ -1.302 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf 23.073 0 Td [(.)]TJ -55.452 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf 41.898 0 Td [(.)]TJ -71.509 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(in)]TJ/F8 9.9626 Tf 9.547 0 Td [(.)]TJ -43.033 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-445(a)-333(structured)-333(data)-333(of)-334(t)28(yp)-28(e)]TJ +0 0 1 rg 0 0 1 RG +/F30 9.9626 Tf 170.915 0 Td [(psb)]TJ +ET +q +1 0 0 1 312.036 120.525 cm +[]0 d 0 J 0.398 w 0 0 m 3.138 0 l S +Q +BT +/F30 9.9626 Tf 315.174 120.326 Td [(desc)]TJ +ET +q +1 0 0 1 336.723 120.525 cm +[]0 d 0 J 0.398 w 0 0 m 3.138 0 l S +Q +BT +/F30 9.9626 Tf 339.861 120.326 Td [(type)]TJ +0 g 0 G +/F8 9.9626 Tf 20.921 0 Td [(.)]TJ +0 g 0 G + -94.012 -29.888 Td [(19)]TJ +0 g 0 G +ET +endstream +endobj +761 0 obj << +/Type /Page +/Contents 762 0 R +/Resources 760 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 764 0 R +/Annots [ 751 0 R 757 0 R 758 0 R 759 0 R ] +>> endobj +751 0 obj << +/Type /Annot +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [135.531 678.732 142.505 690.687] +/Subtype /Link +/A << /S /GoTo /D (section.1) >> +>> endobj +757 0 obj << +/Type /Annot +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [294.721 518.389 361.779 529.514] +/Subtype /Link +/A << /S /GoTo /D (descdata) >> +>> endobj +758 0 obj << +/Type /Annot +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [294.721 331.579 361.779 342.704] +/Subtype /Link +/A << /S /GoTo /D (descdata) >> +>> endobj +759 0 obj << +/Type /Annot +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [294.721 117.115 361.779 128.24] +/Subtype /Link +/A << /S /GoTo /D (descdata) >> +>> endobj +763 0 obj << +/D [761 0 R /XYZ 99.895 740.998 null] +>> endobj +78 0 obj << +/D [761 0 R /XYZ 99.895 636.451 null] +>> endobj +82 0 obj << +/D [761 0 R /XYZ 99.895 449.641 null] +>> endobj +86 0 obj << +/D [761 0 R /XYZ 99.895 234.79 null] +>> endobj +760 0 obj << +/Font << /F27 441 0 R /F8 442 0 R /F14 614 0 R /F10 613 0 R /F30 611 0 R /F16 439 0 R >> +/ProcSet [ /PDF /Text ] +>> endobj +769 0 obj << +/Length 5070 +>> +stream +0 g 0 G +0 g 0 G +0 g 0 G +BT +/F27 9.9626 Tf 150.705 706.129 Td [(On)-383(Return)]TJ +0 g 0 G +0 g 0 G + 0 -23.521 Td [(F)96(unction)-384(v)64(alue)]TJ +0 g 0 G +/F8 9.9626 Tf 78.386 0 Td [(The)-333(comm)27(unication)-333(con)28(text.)]TJ/F27 9.9626 Tf -78.386 -30.664 Td [(psb)]TJ +ET +q +1 0 0 1 168.641 652.143 cm +[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S +Q +BT +/F27 9.9626 Tf 172.078 651.944 Td [(cd)]TJ +ET +q +1 0 0 1 184.223 652.143 cm +[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S +Q +BT +/F27 9.9626 Tf 187.66 651.944 Td [(get)]TJ +ET +q +1 0 0 1 203.782 652.143 cm +[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S +Q +BT +/F27 9.9626 Tf 207.22 651.944 Td [(large)]TJ +ET +q +1 0 0 1 232.357 652.143 cm +[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S +Q +BT +/F27 9.9626 Tf 235.794 651.944 Td [(threshold)-268(|)-268(Get)-268(threshold)-269(for)-268(index)-268(mapping)-268(switc)32(h)]TJ +0 g 0 G +0 g 0 G +/F30 9.9626 Tf -85.089 -20.062 Td [(ith)-525(=)-525(psb_cd_get_large_threshold\050\051)]TJ +0 g 0 G +/F27 9.9626 Tf 0 -24.615 Td [(T)32(yp)-32(e:)]TJ +0 g 0 G +/F8 9.9626 Tf 33.797 0 Td [(Async)28(hronous.)]TJ +0 g 0 G +/F27 9.9626 Tf -33.797 -23.52 Td [(On)-383(Return)]TJ +0 g 0 G +0 g 0 G + 0 -23.521 Td [(F)96(unction)-384(v)64(alue)]TJ +0 g 0 G +/F8 9.9626 Tf 78.386 0 Td [(The)-333(curren)27(t)-333(v)56(alue)-334(for)-333(the)-333(size)-334(threshold.)]TJ/F27 9.9626 Tf -78.386 -30.664 Td [(psb)]TJ +ET +q +1 0 0 1 168.641 529.761 cm +[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S +Q +BT +/F27 9.9626 Tf 172.078 529.562 Td [(cd)]TJ +ET +q +1 0 0 1 184.223 529.761 cm +[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S +Q +BT +/F27 9.9626 Tf 187.66 529.562 Td [(set)]TJ +ET +q +1 0 0 1 202.573 529.761 cm +[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S +Q +BT +/F27 9.9626 Tf 206.01 529.562 Td [(large)]TJ +ET +q +1 0 0 1 231.147 529.761 cm +[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S +Q +BT +/F27 9.9626 Tf 234.585 529.562 Td [(threshold)-323(|)-324(Set)-323(threshold)-323(for)-324(index)-323(mapping)-324(switc)32(h)]TJ +0 g 0 G +0 g 0 G +/F30 9.9626 Tf -83.88 -20.062 Td [(call)-525(psb_cd_set_large_threshold\050ith\051)]TJ +0 g 0 G +/F27 9.9626 Tf 0 -24.615 Td [(T)32(yp)-32(e:)]TJ +0 g 0 G +/F8 9.9626 Tf 33.797 0 Td [(Async)28(hronous.)]TJ +0 g 0 G +/F27 9.9626 Tf -33.797 -23.52 Td [(On)-383(En)32(try)]TJ +0 g 0 G +0 g 0 G + 0 -23.521 Td [(ith)]TJ +0 g 0 G +/F8 9.9626 Tf 18.984 0 Td [(the)-333(new)-334(threshold)-333(for)-333(comm)27(un)1(ic)-1(ati)1(on)-334(descriptors.)]TJ 5.923 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.378 0 Td [(global)]TJ/F8 9.9626 Tf 29.756 0 Td [(.)]TJ -62.135 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.612 0 Td [(required)]TJ/F8 9.9626 Tf 41.898 0 Td [(.)]TJ -71.51 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(in)]TJ/F8 9.9626 Tf 9.548 0 Td [(.)]TJ -43.034 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-445(an)-333(in)28(teger)-333(v)55(alue)-333(greater)-334(th)1(an)-334(zero.)]TJ -24.906 -25.513 Td [(Note:)-756(the)-490(thr)1(e)-1(shold)-489(v)56(alue)-489(is)-490(only)-489(queried)-489(b)28(y)-489(the)-490(library)-489(at)-489(the)-489(time)-490(a)-489(call)]TJ 0 -11.956 Td [(to)]TJ/F30 9.9626 Tf 13.431 0 Td [(psb_cdall)]TJ/F8 9.9626 Tf 51.648 0 Td [(is)-459(executed,)-491(therefore)-459(c)27(hanging)-459(the)-459(threshold)-459(has)-459(no)-460(e\013ect)-459(on)]TJ -65.079 -11.955 Td [(comm)28(unication)-334(descriptors)-333(that)-333(ha)28(v)27(e)-333(already)-333(b)-28(een)-333(initialized.)]TJ/F27 9.9626 Tf 0 -30.664 Td [(get)]TJ +ET +q +1 0 0 1 166.827 310.135 cm +[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S +Q +BT +/F27 9.9626 Tf 170.264 309.936 Td [(nro)32(ws)-383(|)-384(Get)-383(n)32(um)32(b)-32(er)-383(of)-384(ro)32(ws)-383(in)-383(a)-384(sparse)-383(matrix)]TJ +0 g 0 G +0 g 0 G +/F30 9.9626 Tf -19.559 -20.062 Td [(nr)-525(=)-525(a%get_nrows\050\051)]TJ +0 g 0 G +/F27 9.9626 Tf 0 -24.615 Td [(T)32(yp)-32(e:)]TJ +0 g 0 G +/F8 9.9626 Tf 33.797 0 Td [(Async)28(hronous.)]TJ +0 g 0 G +/F27 9.9626 Tf -33.797 -23.52 Td [(On)-383(En)32(try)]TJ +0 g 0 G +0 g 0 G + 0 -23.521 Td [(a)]TJ +0 g 0 G +/F8 9.9626 Tf 10.551 0 Td [(the)-333(sparse)-334(matrix)]TJ 14.355 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.612 0 Td [(required)]TJ/F8 9.9626 Tf -29.612 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(in)]TJ/F8 9.9626 Tf 9.548 0 Td [(.)]TJ -43.034 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-445(a)-333(structured)-333(data)-333(of)-334(t)28(yp)-28(e)]TJ +0 0 1 rg 0 0 1 RG +/F30 9.9626 Tf 170.915 0 Td [(psb)]TJ +ET +q +1 0 0 1 362.845 170.597 cm +[]0 d 0 J 0.398 w 0 0 m 3.138 0 l S +Q +BT +/F30 9.9626 Tf 365.983 170.398 Td [(spmat)]TJ +ET +q +1 0 0 1 392.763 170.597 cm +[]0 d 0 J 0.398 w 0 0 m 3.138 0 l S +Q +BT +/F30 9.9626 Tf 395.901 170.398 Td [(type)]TJ +0 g 0 G +/F8 9.9626 Tf 20.921 0 Td [(.)]TJ +0 g 0 G +/F27 9.9626 Tf -266.117 -24.615 Td [(On)-383(Return)]TJ +0 g 0 G +0 g 0 G + 0 -23.52 Td [(F)96(unction)-384(v)64(alue)]TJ +0 g 0 G +/F8 9.9626 Tf 78.386 0 Td [(The)-333(n)27(um)28(b)-28(er)-333(of)-333(ro)28(ws)-334(of)-333(sparse)-333(matrix)]TJ/F30 9.9626 Tf 164.937 0 Td [(a)]TJ/F8 9.9626 Tf 5.231 0 Td [(.)]TJ +0 g 0 G + -81.68 -31.825 Td [(20)]TJ +0 g 0 G +ET +endstream +endobj +768 0 obj << +/Type /Page +/Contents 769 0 R +/Resources 767 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 764 0 R +/Annots [ 765 0 R ] +>> endobj +765 0 obj << +/Type /Annot +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [345.53 167.187 417.818 178.312] +/Subtype /Link +/A << /S /GoTo /D (spdata) >> +>> endobj +770 0 obj << +/D [768 0 R /XYZ 150.705 740.998 null] +>> endobj +90 0 obj << +/D [768 0 R /XYZ 150.705 642.798 null] +>> endobj +94 0 obj << +/D [768 0 R /XYZ 150.705 520.416 null] +>> endobj +98 0 obj << +/D [768 0 R /XYZ 150.705 300.79 null] +>> endobj +767 0 obj << +/Font << /F27 441 0 R /F8 442 0 R /F30 611 0 R >> +/ProcSet [ /PDF /Text ] +>> endobj +774 0 obj << +/Length 4141 +>> +stream +0 g 0 G +0 g 0 G +BT +/F27 9.9626 Tf 99.895 706.129 Td [(get)]TJ +ET +q +1 0 0 1 116.018 706.328 cm +[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S +Q +BT +/F27 9.9626 Tf 119.455 706.129 Td [(ncols)-383(|)-384(Get)-383(n)32(um)32(b)-32(er)-383(of)-384(columns)-383(in)-383(a)-384(sparse)-383(matrix)]TJ +0 g 0 G +0 g 0 G +/F30 9.9626 Tf -19.56 -18.389 Td [(nr)-525(=)-525(a%get_ncols\050\051)]TJ +0 g 0 G +/F27 9.9626 Tf 0 -21.918 Td [(T)32(yp)-32(e:)]TJ +0 g 0 G +/F8 9.9626 Tf 33.797 0 Td [(Async)28(hronous.)]TJ +0 g 0 G +/F27 9.9626 Tf -33.797 -19.926 Td [(On)-383(En)32(try)]TJ +0 g 0 G +0 g 0 G + 0 -19.925 Td [(a)]TJ +0 g 0 G +/F8 9.9626 Tf 10.551 0 Td [(the)-333(sparse)-334(matrix)]TJ 14.356 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf -29.611 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(in)]TJ/F8 9.9626 Tf 9.547 0 Td [(.)]TJ -43.033 -11.956 Td [(Sp)-28(eci\014ed)-333(as:)-445(a)-333(structured)-333(data)-333(of)-334(t)28(yp)-28(e)]TJ +0 0 1 rg 0 0 1 RG +/F30 9.9626 Tf 170.915 0 Td [(psb)]TJ +ET +q +1 0 0 1 312.036 578.35 cm +[]0 d 0 J 0.398 w 0 0 m 3.138 0 l S +Q +BT +/F30 9.9626 Tf 315.174 578.15 Td [(spmat)]TJ +ET +q +1 0 0 1 341.953 578.35 cm +[]0 d 0 J 0.398 w 0 0 m 3.138 0 l S +Q +BT +/F30 9.9626 Tf 345.091 578.15 Td [(type)]TJ +0 g 0 G +/F8 9.9626 Tf 20.922 0 Td [(.)]TJ +0 g 0 G +/F27 9.9626 Tf -266.118 -21.917 Td [(On)-383(Return)]TJ +0 g 0 G +0 g 0 G + 0 -19.926 Td [(F)96(unction)-384(v)64(alue)]TJ +0 g 0 G +/F8 9.9626 Tf 78.387 0 Td [(The)-333(n)27(u)1(m)27(b)-27(e)-1(r)-333(of)-333(columns)-333(of)-334(sparse)-333(matrix)]TJ/F30 9.9626 Tf 180.683 0 Td [(a)]TJ/F8 9.9626 Tf 5.231 0 Td [(.)]TJ/F27 9.9626 Tf -264.301 -25.896 Td [(get)]TJ +ET +q +1 0 0 1 116.018 510.611 cm +[]0 d 0 J 0.398 w 0 0 m 3.437 0 l S +Q +BT +/F27 9.9626 Tf 119.455 510.411 Td [(nnzeros)-383(|)-384(Get)-383(n)32(um)32(b)-32(er)-383(of)-384(nonzero)-383(elemen)32(ts)-383(in)-384(a)-383(sparse)-383(ma)-1(trix)]TJ +0 g 0 G +0 g 0 G +/F30 9.9626 Tf -19.56 -18.389 Td [(nr)-525(=)-525(a%get_nnzeros\050\051)]TJ +0 g 0 G +/F27 9.9626 Tf 0 -21.918 Td [(T)32(yp)-32(e:)]TJ +0 g 0 G +/F8 9.9626 Tf 33.797 0 Td [(Async)28(hronous.)]TJ +0 g 0 G +/F27 9.9626 Tf -33.797 -19.925 Td [(On)-383(En)32(try)]TJ +0 g 0 G +0 g 0 G + 0 -19.925 Td [(a)]TJ +0 g 0 G +/F8 9.9626 Tf 10.551 0 Td [(the)-333(sparse)-334(matrix)]TJ 14.356 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.956 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf -29.611 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(in)]TJ/F8 9.9626 Tf 9.547 0 Td [(.)]TJ -43.033 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-445(a)-333(structured)-333(data)-333(of)-334(t)28(yp)-28(e)]TJ +0 0 1 rg 0 0 1 RG +/F30 9.9626 Tf 170.915 0 Td [(psb)]TJ +ET +q +1 0 0 1 312.036 382.632 cm +[]0 d 0 J 0.398 w 0 0 m 3.138 0 l S +Q +BT +/F30 9.9626 Tf 315.174 382.433 Td [(spmat)]TJ +ET +q +1 0 0 1 341.953 382.632 cm +[]0 d 0 J 0.398 w 0 0 m 3.138 0 l S +Q +BT +/F30 9.9626 Tf 345.091 382.433 Td [(type)]TJ +0 g 0 G +/F8 9.9626 Tf 20.922 0 Td [(.)]TJ +0 g 0 G +/F27 9.9626 Tf -266.118 -21.918 Td [(On)-383(Return)]TJ +0 g 0 G +0 g 0 G + 0 -19.925 Td [(F)96(unction)-384(v)64(alue)]TJ +0 g 0 G +/F8 9.9626 Tf 78.387 0 Td [(The)-333(n)27(u)1(m)27(b)-27(e)-1(r)-333(of)-333(nonzero)-333(elem)-1(en)28(ts)-333(stored)-333(in)-334(sparse)-333(matrix)]TJ/F30 9.9626 Tf 249.979 0 Td [(a)]TJ/F8 9.9626 Tf 5.231 0 Td [(.)]TJ/F27 9.9626 Tf -333.597 -21.918 Td [(Notes)]TJ +0 g 0 G +/F8 9.9626 Tf 12.177 -19.925 Td [(1.)]TJ +0 g 0 G + [-500(The)-462(function)-462(v)55(alue)-462(is)-462(sp)-28(eci\014c)-462(to)-462(the)-463(storage)-462(format)-462(of)-462(matrix)]TJ/F30 9.9626 Tf 296.649 0 Td [(a)]TJ/F8 9.9626 Tf 5.23 0 Td [(;)-527(some)]TJ -289.149 -11.955 Td [(storage)-465(formats)-466(emplo)28(y)-465(padding,)-498(th)27(u)1(s)-466(the)-465(returned)-465(v)55(alue)-465(for)-465(the)-466(same)]TJ 0 -11.955 Td [(matrix)-333(ma)27(y)-333(b)-28(e)-333(di\013eren)28(t)-334(for)-333(di\013eren)28(t)-333(storage)-334(c)28(hoices.)]TJ +0 g 0 G + 141.968 -184.399 Td [(21)]TJ +0 g 0 G +ET +endstream +endobj +773 0 obj << +/Type /Page +/Contents 774 0 R +/Resources 772 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 764 0 R +/Annots [ 766 0 R 771 0 R ] +>> endobj +766 0 obj << +/Type /Annot +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [294.721 574.94 367.009 586.065] +/Subtype /Link +/A << /S /GoTo /D (spdata) >> +>> endobj +771 0 obj << +/Type /Annot +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [294.721 379.223 367.009 390.348] +/Subtype /Link +/A << /S /GoTo /D (spdata) >> +>> endobj +775 0 obj << +/D [773 0 R /XYZ 99.895 740.998 null] +>> endobj +102 0 obj << +/D [773 0 R /XYZ 99.895 697.758 null] +>> endobj +106 0 obj << +/D [773 0 R /XYZ 99.895 502.04 null] +>> endobj +776 0 obj << +/D [773 0 R /XYZ 99.895 314.687 null] +>> endobj +772 0 obj << +/Font << /F27 441 0 R /F30 611 0 R /F8 442 0 R >> +/ProcSet [ /PDF /Text ] +>> endobj +779 0 obj << +/Length 158 +>> +stream +0 g 0 G +0 g 0 G +BT +/F16 14.3462 Tf 150.705 706.129 Td [(4)-1125(Computational)-375(routines)]TJ +0 g 0 G +/F8 9.9626 Tf 166.874 -615.691 Td [(22)]TJ +0 g 0 G +ET +endstream +endobj +778 0 obj << +/Type /Page +/Contents 779 0 R +/Resources 777 0 R +/MediaBox [0 0 595.276 841.89] +/Parent 764 0 R +>> endobj +780 0 obj << +/D [778 0 R /XYZ 150.705 740.998 null] +>> endobj +110 0 obj << +/D [778 0 R /XYZ 150.705 716.092 null] +>> endobj +777 0 obj << +/Font << /F16 439 0 R /F8 442 0 R >> +/ProcSet [ /PDF /Text ] +>> endobj +789 0 obj << /Length 6970 >> stream @@ -6112,68 +6337,68 @@ BT 0 g 0 G /F8 9.9626 Tf 20.921 0 Td [(.)]TJ 0 g 0 G - -94.012 -29.888 Td [(21)]TJ + -94.012 -29.888 Td [(23)]TJ 0 g 0 G ET endstream endobj -763 0 obj << +788 0 obj << /Type /Page -/Contents 764 0 R -/Resources 762 0 R +/Contents 789 0 R +/Resources 787 0 R /MediaBox [0 0 595.276 841.89] -/Parent 751 0 R -/Annots [ 756 0 R 757 0 R 758 0 R 759 0 R 760 0 R ] +/Parent 764 0 R +/Annots [ 781 0 R 782 0 R 783 0 R 784 0 R 785 0 R ] >> endobj -756 0 obj << +781 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [382.088 410.346 389.062 421.194] /Subtype /Link /A << /S /GoTo /D (table.1) >> >> endobj -757 0 obj << +782 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [162.826 331.13 169.8 341.978] /Subtype /Link /A << /S /GoTo /D (table.1) >> >> endobj -758 0 obj << +783 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [382.088 263.869 389.062 274.717] /Subtype /Link /A << /S /GoTo /D (table.1) >> >> endobj -759 0 obj << +784 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [205.998 184.653 212.972 195.501] /Subtype /Link /A << /S /GoTo /D (table.1) >> >> endobj -760 0 obj << +785 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [294.721 117.115 361.779 128.24] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -765 0 obj << -/D [763 0 R /XYZ 99.895 740.998 null] +790 0 obj << +/D [788 0 R /XYZ 99.895 740.998 null] >> endobj -106 0 obj << -/D [763 0 R /XYZ 99.895 697.37 null] +114 0 obj << +/D [788 0 R /XYZ 99.895 697.37 null] >> endobj -766 0 obj << -/D [763 0 R /XYZ 267.641 543.834 null] +791 0 obj << +/D [788 0 R /XYZ 267.641 543.834 null] >> endobj -762 0 obj << -/Font << /F16 431 0 R /F8 434 0 R /F11 587 0 R /F14 604 0 R /F30 601 0 R /F27 433 0 R >> +787 0 obj << +/Font << /F16 439 0 R /F8 442 0 R /F11 597 0 R /F14 614 0 R /F30 611 0 R /F27 441 0 R >> /ProcSet [ /PDF /Text ] >> endobj -769 0 obj << +794 0 obj << /Length 1495 >> stream @@ -6196,34 +6421,34 @@ BT 0 g 0 G /F8 9.9626 Tf 23.758 0 Td [(Error)-333(co)-28(de.)]TJ 1.149 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.378 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.378 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf -29.611 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.485 0 Td [(out)]TJ/F8 9.9626 Tf 16.549 0 Td [(.)]TJ -50.034 -11.955 Td [(An)-333(in)28(teger)-334(v)56(alue;)-334(0)-333(means)-333(no)-334(error)-333(has)-333(b)-28(een)-333(detected.)]TJ 0 g 0 G - 141.967 -468.244 Td [(22)]TJ + 141.967 -468.244 Td [(24)]TJ 0 g 0 G ET endstream endobj -768 0 obj << +793 0 obj << /Type /Page -/Contents 769 0 R -/Resources 767 0 R +/Contents 794 0 R +/Resources 792 0 R /MediaBox [0 0 595.276 841.89] -/Parent 751 0 R -/Annots [ 761 0 R ] +/Parent 764 0 R +/Annots [ 786 0 R ] >> endobj -761 0 obj << +786 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [256.807 625.431 263.781 634.343] /Subtype /Link /A << /S /GoTo /D (table.1) >> >> endobj -770 0 obj << -/D [768 0 R /XYZ 150.705 740.998 null] +795 0 obj << +/D [793 0 R /XYZ 150.705 740.998 null] >> endobj -767 0 obj << -/Font << /F27 433 0 R /F8 434 0 R /F11 587 0 R >> +792 0 obj << +/Font << /F27 441 0 R /F8 442 0 R /F11 597 0 R >> /ProcSet [ /PDF /Text ] >> endobj -777 0 obj << +802 0 obj << /Length 6909 >> stream @@ -6360,61 +6585,61 @@ BT 0 g 0 G [(.)]TJ 0 g 0 G - 141.968 -29.888 Td [(23)]TJ + 141.968 -29.888 Td [(25)]TJ 0 g 0 G ET endstream endobj -776 0 obj << +801 0 obj << /Type /Page -/Contents 777 0 R -/Resources 775 0 R +/Contents 802 0 R +/Resources 800 0 R /MediaBox [0 0 595.276 841.89] -/Parent 751 0 R -/Annots [ 771 0 R 772 0 R 773 0 R 774 0 R ] +/Parent 805 0 R +/Annots [ 796 0 R 797 0 R 798 0 R 799 0 R ] >> endobj -771 0 obj << +796 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [203.009 332.314 209.983 343.163] /Subtype /Link /A << /S /GoTo /D (table.2) >> >> endobj -772 0 obj << +797 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [203.009 251.685 209.983 262.533] /Subtype /Link /A << /S /GoTo /D (table.2) >> >> endobj -773 0 obj << +798 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [294.721 182.733 361.779 193.858] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -774 0 obj << +799 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [382.088 117.392 389.062 128.24] /Subtype /Link /A << /S /GoTo /D (table.2) >> >> endobj -778 0 obj << -/D [776 0 R /XYZ 99.895 740.998 null] +803 0 obj << +/D [801 0 R /XYZ 99.895 740.998 null] >> endobj -110 0 obj << -/D [776 0 R /XYZ 99.895 697.17 null] +118 0 obj << +/D [801 0 R /XYZ 99.895 697.17 null] >> endobj -779 0 obj << -/D [776 0 R /XYZ 267.641 483.443 null] +804 0 obj << +/D [801 0 R /XYZ 267.641 483.443 null] >> endobj -775 0 obj << -/Font << /F16 431 0 R /F8 434 0 R /F11 587 0 R /F14 604 0 R /F10 603 0 R /F30 601 0 R /F27 433 0 R >> +800 0 obj << +/Font << /F16 439 0 R /F8 442 0 R /F11 597 0 R /F14 614 0 R /F10 613 0 R /F30 611 0 R /F27 441 0 R >> /ProcSet [ /PDF /Text ] >> endobj -782 0 obj << +808 0 obj << /Length 625 >> stream @@ -6426,26 +6651,26 @@ BT 0 g 0 G /F8 9.9626 Tf 23.758 0 Td [(Error)-333(co)-28(de.)]TJ 1.148 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.612 0 Td [(required)]TJ/F8 9.9626 Tf -29.612 -11.956 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(out)]TJ/F8 9.9626 Tf 16.549 0 Td [(.)]TJ -50.035 -11.955 Td [(An)-333(in)27(t)1(e)-1(ger)-333(v)56(alue;)-334(0)-333(means)-333(no)-334(error)-333(has)-333(b)-28(een)-333(detec)-1(ted.)]TJ 0 g 0 G - 141.968 -567.87 Td [(24)]TJ + 141.968 -567.87 Td [(26)]TJ 0 g 0 G ET endstream endobj -781 0 obj << +807 0 obj << /Type /Page -/Contents 782 0 R -/Resources 780 0 R +/Contents 808 0 R +/Resources 806 0 R /MediaBox [0 0 595.276 841.89] -/Parent 751 0 R +/Parent 805 0 R >> endobj -783 0 obj << -/D [781 0 R /XYZ 150.705 740.998 null] +809 0 obj << +/D [807 0 R /XYZ 150.705 740.998 null] >> endobj -780 0 obj << -/Font << /F27 433 0 R /F8 434 0 R >> +806 0 obj << +/Font << /F27 441 0 R /F8 442 0 R >> /ProcSet [ /PDF /Text ] >> endobj -790 0 obj << +816 0 obj << /Length 7473 >> stream @@ -6582,61 +6807,61 @@ BT 0 g 0 G [(.)]TJ 0 g 0 G - 141.968 -29.888 Td [(25)]TJ + 141.968 -29.888 Td [(27)]TJ 0 g 0 G ET endstream endobj -789 0 obj << +815 0 obj << /Type /Page -/Contents 790 0 R -/Resources 788 0 R +/Contents 816 0 R +/Resources 814 0 R /MediaBox [0 0 595.276 841.89] -/Parent 793 0 R -/Annots [ 784 0 R 785 0 R 786 0 R 787 0 R ] +/Parent 805 0 R +/Annots [ 810 0 R 811 0 R 812 0 R 813 0 R ] >> endobj -784 0 obj << +810 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [203.009 352.148 209.983 362.996] /Subtype /Link /A << /S /GoTo /D (table.3) >> >> endobj -785 0 obj << +811 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [203.009 272.537 209.983 283.386] /Subtype /Link /A << /S /GoTo /D (table.3) >> >> endobj -786 0 obj << +812 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [294.721 204.605 361.779 215.73] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -787 0 obj << +813 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [151.203 119.329 158.177 128.24] /Subtype /Link /A << /S /GoTo /D (table.2) >> >> endobj -791 0 obj << -/D [789 0 R /XYZ 99.895 740.998 null] +817 0 obj << +/D [815 0 R /XYZ 99.895 740.998 null] >> endobj -114 0 obj << -/D [789 0 R /XYZ 99.895 697.37 null] +122 0 obj << +/D [815 0 R /XYZ 99.895 697.37 null] >> endobj -792 0 obj << -/D [789 0 R /XYZ 267.641 499.76 null] +818 0 obj << +/D [815 0 R /XYZ 267.641 499.76 null] >> endobj -788 0 obj << -/Font << /F16 431 0 R /F8 434 0 R /F11 587 0 R /F14 604 0 R /F10 603 0 R /F30 601 0 R /F27 433 0 R >> +814 0 obj << +/Font << /F16 439 0 R /F8 442 0 R /F11 597 0 R /F14 614 0 R /F10 613 0 R /F30 611 0 R /F27 441 0 R >> /ProcSet [ /PDF /Text ] >> endobj -796 0 obj << +821 0 obj << /Length 625 >> stream @@ -6648,26 +6873,26 @@ BT 0 g 0 G /F8 9.9626 Tf 23.758 0 Td [(Error)-333(co)-28(de.)]TJ 1.148 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.612 0 Td [(required)]TJ/F8 9.9626 Tf -29.612 -11.956 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(out)]TJ/F8 9.9626 Tf 16.549 0 Td [(.)]TJ -50.035 -11.955 Td [(An)-333(in)27(t)1(e)-1(ger)-333(v)56(alue;)-334(0)-333(means)-333(no)-334(error)-333(has)-333(b)-28(een)-333(detec)-1(ted.)]TJ 0 g 0 G - 141.968 -567.87 Td [(26)]TJ + 141.968 -567.87 Td [(28)]TJ 0 g 0 G ET endstream endobj -795 0 obj << +820 0 obj << /Type /Page -/Contents 796 0 R -/Resources 794 0 R +/Contents 821 0 R +/Resources 819 0 R /MediaBox [0 0 595.276 841.89] -/Parent 793 0 R +/Parent 805 0 R >> endobj -797 0 obj << -/D [795 0 R /XYZ 150.705 740.998 null] +822 0 obj << +/D [820 0 R /XYZ 150.705 740.998 null] >> endobj -794 0 obj << -/Font << /F27 433 0 R /F8 434 0 R >> +819 0 obj << +/Font << /F27 441 0 R /F8 442 0 R >> /ProcSet [ /PDF /Text ] >> endobj -802 0 obj << +827 0 obj << /Length 6532 >> stream @@ -6796,47 +7021,47 @@ BT 0 g 0 G /F8 9.9626 Tf 23.758 0 Td [(Error)-333(co)-28(de.)]TJ 1.149 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf -29.611 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(out)]TJ/F8 9.9626 Tf 16.549 0 Td [(.)]TJ -50.035 -11.955 Td [(An)-333(in)28(tege)-1(r)-333(v)56(alue;)-334(0)-333(means)-333(no)-334(error)-333(has)-333(b)-28(een)-333(detecte)-1(d)1(.)]TJ 0 g 0 G - 141.968 -45.795 Td [(27)]TJ + 141.968 -45.795 Td [(29)]TJ 0 g 0 G ET endstream endobj -801 0 obj << +826 0 obj << /Type /Page -/Contents 802 0 R -/Resources 800 0 R +/Contents 827 0 R +/Resources 825 0 R /MediaBox [0 0 595.276 841.89] -/Parent 793 0 R -/Annots [ 798 0 R 799 0 R ] +/Parent 805 0 R +/Annots [ 823 0 R 824 0 R ] >> endobj -798 0 obj << +823 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [162.826 334.489 169.8 343.4] /Subtype /Link /A << /S /GoTo /D (table.4) >> >> endobj -799 0 obj << +824 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [294.721 264.529 361.779 275.654] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -803 0 obj << -/D [801 0 R /XYZ 99.895 740.998 null] +828 0 obj << +/D [826 0 R /XYZ 99.895 740.998 null] >> endobj -118 0 obj << -/D [801 0 R /XYZ 99.895 697.37 null] +126 0 obj << +/D [826 0 R /XYZ 99.895 697.37 null] >> endobj -804 0 obj << -/D [801 0 R /XYZ 267.641 480.663 null] +829 0 obj << +/D [826 0 R /XYZ 267.641 480.663 null] >> endobj -800 0 obj << -/Font << /F16 431 0 R /F8 434 0 R /F11 587 0 R /F14 604 0 R /F10 603 0 R /F30 601 0 R /F27 433 0 R >> +825 0 obj << +/Font << /F16 439 0 R /F8 442 0 R /F11 597 0 R /F14 614 0 R /F10 613 0 R /F30 611 0 R /F27 441 0 R >> /ProcSet [ /PDF /Text ] >> endobj -809 0 obj << +834 0 obj << /Length 5812 >> stream @@ -6965,47 +7190,47 @@ BT 0 g 0 G /F8 9.9626 Tf 23.758 0 Td [(Error)-333(co)-28(de.)]TJ 1.148 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.612 0 Td [(required)]TJ/F8 9.9626 Tf -29.612 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(out)]TJ/F8 9.9626 Tf 16.549 0 Td [(.)]TJ -50.035 -11.956 Td [(An)-333(in)27(t)1(e)-1(ger)-333(v)56(alue;)-334(0)-333(means)-333(no)-334(error)-333(has)-333(b)-28(een)-333(detec)-1(ted.)]TJ 0 g 0 G - 141.968 -90.64 Td [(28)]TJ + 141.968 -90.64 Td [(30)]TJ 0 g 0 G ET endstream endobj -808 0 obj << +833 0 obj << /Type /Page -/Contents 809 0 R -/Resources 807 0 R +/Contents 834 0 R +/Resources 832 0 R /MediaBox [0 0 595.276 841.89] -/Parent 793 0 R -/Annots [ 805 0 R 806 0 R ] +/Parent 805 0 R +/Annots [ 830 0 R 831 0 R ] >> endobj -805 0 obj << +830 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [213.636 391.29 220.609 400.201] /Subtype /Link /A << /S /GoTo /D (table.5) >> >> endobj -806 0 obj << +831 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [345.53 321.33 412.588 332.455] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -810 0 obj << -/D [808 0 R /XYZ 150.705 740.998 null] +835 0 obj << +/D [833 0 R /XYZ 150.705 740.998 null] >> endobj -122 0 obj << -/D [808 0 R /XYZ 150.705 697.37 null] +130 0 obj << +/D [833 0 R /XYZ 150.705 697.37 null] >> endobj -811 0 obj << -/D [808 0 R /XYZ 318.451 537.464 null] +836 0 obj << +/D [833 0 R /XYZ 318.451 537.464 null] >> endobj -807 0 obj << -/Font << /F16 431 0 R /F8 434 0 R /F11 587 0 R /F14 604 0 R /F10 603 0 R /F30 601 0 R /F27 433 0 R >> +832 0 obj << +/Font << /F16 439 0 R /F8 442 0 R /F11 597 0 R /F14 614 0 R /F10 613 0 R /F30 611 0 R /F27 441 0 R >> /ProcSet [ /PDF /Text ] >> endobj -816 0 obj << +841 0 obj << /Length 6175 >> stream @@ -7134,47 +7359,47 @@ BT 0 g 0 G /F8 9.9626 Tf 23.758 0 Td [(Error)-333(co)-28(de.)]TJ 1.149 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf -29.611 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(out)]TJ/F8 9.9626 Tf 16.549 0 Td [(.)]TJ -50.035 -11.955 Td [(An)-333(in)28(tege)-1(r)-333(v)56(alue;)-334(0)-333(means)-333(no)-334(error)-333(has)-333(b)-28(een)-333(detecte)-1(d)1(.)]TJ 0 g 0 G - 141.968 -52.257 Td [(29)]TJ + 141.968 -52.257 Td [(31)]TJ 0 g 0 G ET endstream endobj -815 0 obj << +840 0 obj << /Type /Page -/Contents 816 0 R -/Resources 814 0 R +/Contents 841 0 R +/Resources 839 0 R /MediaBox [0 0 595.276 841.89] -/Parent 793 0 R -/Annots [ 812 0 R 813 0 R ] +/Parent 844 0 R +/Annots [ 837 0 R 838 0 R ] >> endobj -812 0 obj << +837 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [162.826 340.951 169.8 349.862] /Subtype /Link /A << /S /GoTo /D (table.6) >> >> endobj -813 0 obj << +838 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [294.721 270.991 361.779 282.116] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -817 0 obj << -/D [815 0 R /XYZ 99.895 740.998 null] +842 0 obj << +/D [840 0 R /XYZ 99.895 740.998 null] >> endobj -126 0 obj << -/D [815 0 R /XYZ 99.895 697.37 null] +134 0 obj << +/D [840 0 R /XYZ 99.895 697.37 null] >> endobj -818 0 obj << -/D [815 0 R /XYZ 267.641 487.125 null] +843 0 obj << +/D [840 0 R /XYZ 267.641 487.125 null] >> endobj -814 0 obj << -/Font << /F16 431 0 R /F8 434 0 R /F11 587 0 R /F14 604 0 R /F10 603 0 R /F7 602 0 R /F30 601 0 R /F27 433 0 R >> +839 0 obj << +/Font << /F16 439 0 R /F8 442 0 R /F11 597 0 R /F14 614 0 R /F10 613 0 R /F7 612 0 R /F30 611 0 R /F27 441 0 R >> /ProcSet [ /PDF /Text ] >> endobj -823 0 obj << +849 0 obj << /Length 6862 >> stream @@ -7299,47 +7524,47 @@ BT 0 g 0 G /F8 9.9626 Tf 19.47 0 Td [(con)28(tains)-334(th)1(e)-334(1-norm)-333(of)-333(\050the)-334(columns)-333(of)-78(\051)]TJ/F11 9.9626 Tf 177.75 0 Td [(x)]TJ/F8 9.9626 Tf 5.694 0 Td [(.)]TJ -178.008 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(global)]TJ/F8 9.9626 Tf -32.379 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(out)]TJ/F8 9.9626 Tf 16.549 0 Td [(.)]TJ -50.035 -11.955 Td [(Short)-324(as:)-440(a)-324(long)-324(precision)-325(r)1(e)-1(al)-324(n)28(um)28(b)-28(er.)-441(Sp)-28(eci\014ed)-324(as:)-440(a)-324(long)-324(precision)-325(real)]TJ 0 -11.955 Td [(n)28(um)28(b)-28(er.)]TJ 0 g 0 G - 141.968 -29.888 Td [(30)]TJ + 141.968 -29.888 Td [(32)]TJ 0 g 0 G ET endstream endobj -822 0 obj << +848 0 obj << /Type /Page -/Contents 823 0 R -/Resources 821 0 R +/Contents 849 0 R +/Resources 847 0 R /MediaBox [0 0 595.276 841.89] -/Parent 793 0 R -/Annots [ 819 0 R 820 0 R ] +/Parent 844 0 R +/Annots [ 845 0 R 846 0 R ] >> endobj -819 0 obj << +845 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [213.636 280.099 220.609 289.01] /Subtype /Link /A << /S /GoTo /D (table.7) >> >> endobj -820 0 obj << +846 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [345.53 208.355 412.588 219.48] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -824 0 obj << -/D [822 0 R /XYZ 150.705 740.998 null] +850 0 obj << +/D [848 0 R /XYZ 150.705 740.998 null] >> endobj -130 0 obj << -/D [822 0 R /XYZ 150.705 696.986 null] +138 0 obj << +/D [848 0 R /XYZ 150.705 696.986 null] >> endobj -825 0 obj << -/D [822 0 R /XYZ 318.451 432.072 null] +851 0 obj << +/D [848 0 R /XYZ 318.451 432.072 null] >> endobj -821 0 obj << -/Font << /F16 431 0 R /F8 434 0 R /F11 587 0 R /F14 604 0 R /F10 603 0 R /F7 602 0 R /F30 601 0 R /F27 433 0 R >> +847 0 obj << +/Font << /F16 439 0 R /F8 442 0 R /F11 597 0 R /F14 614 0 R /F10 613 0 R /F7 612 0 R /F30 611 0 R /F27 441 0 R >> /ProcSet [ /PDF /Text ] >> endobj -828 0 obj << +854 0 obj << /Length 624 >> stream @@ -7351,26 +7576,26 @@ BT 0 g 0 G /F8 9.9626 Tf 23.758 0 Td [(Error)-333(co)-28(de.)]TJ 1.149 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf -29.611 -11.956 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(out)]TJ/F8 9.9626 Tf 16.549 0 Td [(.)]TJ -50.035 -11.955 Td [(An)-333(in)28(tege)-1(r)-333(v)56(alue;)-334(0)-333(means)-333(no)-334(error)-333(has)-333(b)-28(een)-333(detecte)-1(d)1(.)]TJ 0 g 0 G - 141.968 -567.87 Td [(31)]TJ + 141.968 -567.87 Td [(33)]TJ 0 g 0 G ET endstream endobj -827 0 obj << +853 0 obj << /Type /Page -/Contents 828 0 R -/Resources 826 0 R +/Contents 854 0 R +/Resources 852 0 R /MediaBox [0 0 595.276 841.89] -/Parent 830 0 R +/Parent 844 0 R >> endobj -829 0 obj << -/D [827 0 R /XYZ 99.895 740.998 null] +855 0 obj << +/D [853 0 R /XYZ 99.895 740.998 null] >> endobj -826 0 obj << -/Font << /F27 433 0 R /F8 434 0 R >> +852 0 obj << +/Font << /F27 441 0 R /F8 442 0 R >> /ProcSet [ /PDF /Text ] >> endobj -835 0 obj << +860 0 obj << /Length 6259 >> stream @@ -7513,47 +7738,47 @@ BT 0 g 0 G /F8 9.9626 Tf 23.758 0 Td [(Error)-333(co)-28(de.)]TJ 1.149 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.378 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.378 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf -29.611 -11.956 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.485 0 Td [(out)]TJ/F8 9.9626 Tf 16.549 0 Td [(.)]TJ -50.034 -11.955 Td [(An)-333(in)28(teger)-334(v)56(alue;)-334(0)-333(means)-333(no)-334(error)-333(has)-333(b)-28(een)-333(detected.)]TJ 0 g 0 G - 141.967 -41.423 Td [(32)]TJ + 141.967 -41.423 Td [(34)]TJ 0 g 0 G ET endstream endobj -834 0 obj << +859 0 obj << /Type /Page -/Contents 835 0 R -/Resources 833 0 R +/Contents 860 0 R +/Resources 858 0 R /MediaBox [0 0 595.276 841.89] -/Parent 830 0 R -/Annots [ 831 0 R 832 0 R ] +/Parent 844 0 R +/Annots [ 856 0 R 857 0 R ] >> endobj -831 0 obj << +856 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [213.636 341.49 220.609 350.401] /Subtype /Link /A << /S /GoTo /D (table.8) >> >> endobj -832 0 obj << +857 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [345.53 271.676 412.588 282.801] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -836 0 obj << -/D [834 0 R /XYZ 150.705 740.998 null] +861 0 obj << +/D [859 0 R /XYZ 150.705 740.998 null] >> endobj -134 0 obj << -/D [834 0 R /XYZ 150.705 697.37 null] +142 0 obj << +/D [859 0 R /XYZ 150.705 697.37 null] >> endobj -837 0 obj << -/D [834 0 R /XYZ 318.451 510.406 null] +862 0 obj << +/D [859 0 R /XYZ 318.451 510.406 null] >> endobj -833 0 obj << -/Font << /F16 431 0 R /F8 434 0 R /F11 587 0 R /F14 604 0 R /F10 603 0 R /F27 433 0 R /F30 601 0 R >> +858 0 obj << +/Font << /F16 439 0 R /F8 442 0 R /F11 597 0 R /F14 614 0 R /F10 613 0 R /F27 441 0 R /F30 611 0 R >> /ProcSet [ /PDF /Text ] >> endobj -842 0 obj << +867 0 obj << /Length 5648 >> stream @@ -7682,47 +7907,47 @@ BT 0 g 0 G /F8 9.9626 Tf 23.758 0 Td [(Error)-333(co)-28(de.)]TJ 1.149 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf -29.611 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(out)]TJ/F8 9.9626 Tf 16.549 0 Td [(.)]TJ -50.035 -11.955 Td [(An)-333(in)28(tege)-1(r)-333(v)56(alue;)-334(0)-333(means)-333(no)-334(error)-333(has)-333(b)-28(een)-333(detecte)-1(d)1(.)]TJ 0 g 0 G - 141.968 -94.1 Td [(33)]TJ + 141.968 -94.1 Td [(35)]TJ 0 g 0 G ET endstream endobj -841 0 obj << +866 0 obj << /Type /Page -/Contents 842 0 R -/Resources 840 0 R +/Contents 867 0 R +/Resources 865 0 R /MediaBox [0 0 595.276 841.89] -/Parent 830 0 R -/Annots [ 838 0 R 839 0 R ] +/Parent 844 0 R +/Annots [ 863 0 R 864 0 R ] >> endobj -838 0 obj << +863 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [162.826 394.749 169.8 403.66] /Subtype /Link /A << /S /GoTo /D (table.9) >> >> endobj -839 0 obj << +864 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [294.721 324.789 361.779 335.914] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -843 0 obj << -/D [841 0 R /XYZ 99.895 740.998 null] +868 0 obj << +/D [866 0 R /XYZ 99.895 740.998 null] >> endobj -138 0 obj << -/D [841 0 R /XYZ 99.895 697.37 null] +146 0 obj << +/D [866 0 R /XYZ 99.895 697.37 null] >> endobj -844 0 obj << -/D [841 0 R /XYZ 267.641 540.923 null] +869 0 obj << +/D [866 0 R /XYZ 267.641 540.923 null] >> endobj -840 0 obj << -/Font << /F16 431 0 R /F8 434 0 R /F11 587 0 R /F14 604 0 R /F7 602 0 R /F30 601 0 R /F27 433 0 R >> +865 0 obj << +/Font << /F16 439 0 R /F8 442 0 R /F11 597 0 R /F14 614 0 R /F7 612 0 R /F30 611 0 R /F27 441 0 R >> /ProcSet [ /PDF /Text ] >> endobj -849 0 obj << +874 0 obj << /Length 5477 >> stream @@ -7869,47 +8094,47 @@ BT 0 g 0 G /F8 9.9626 Tf 23.758 0 Td [(Error)-333(co)-28(de.)]TJ 1.148 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.612 0 Td [(required)]TJ/F8 9.9626 Tf -29.612 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(out)]TJ/F8 9.9626 Tf 16.549 0 Td [(.)]TJ -50.035 -11.955 Td [(An)-333(in)28(te)-1(ger)-333(v)56(alue;)-334(0)-333(means)-333(no)-334(error)-333(has)-333(b)-28(een)-333(detec)-1(ted.)]TJ 0 g 0 G - 141.968 -68.197 Td [(34)]TJ + 141.968 -68.197 Td [(36)]TJ 0 g 0 G ET endstream endobj -848 0 obj << +873 0 obj << /Type /Page -/Contents 849 0 R -/Resources 847 0 R +/Contents 874 0 R +/Resources 872 0 R /MediaBox [0 0 595.276 841.89] -/Parent 830 0 R -/Annots [ 845 0 R 846 0 R ] +/Parent 844 0 R +/Annots [ 870 0 R 871 0 R ] >> endobj -845 0 obj << +870 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [345.53 354.677 417.818 365.802] /Subtype /Link /A << /S /GoTo /D (spdata) >> >> endobj -846 0 obj << +871 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [345.53 286.931 412.588 298.056] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -850 0 obj << -/D [848 0 R /XYZ 150.705 740.998 null] +875 0 obj << +/D [873 0 R /XYZ 150.705 740.998 null] >> endobj -142 0 obj << -/D [848 0 R /XYZ 150.705 697.37 null] +150 0 obj << +/D [873 0 R /XYZ 150.705 697.37 null] >> endobj -852 0 obj << -/D [848 0 R /XYZ 320.941 513.305 null] +877 0 obj << +/D [873 0 R /XYZ 320.941 513.305 null] >> endobj -847 0 obj << -/Font << /F16 431 0 R /F8 434 0 R /F11 587 0 R /F14 604 0 R /F13 851 0 R /F27 433 0 R /F30 601 0 R >> +872 0 obj << +/Font << /F16 439 0 R /F8 442 0 R /F11 597 0 R /F14 614 0 R /F13 876 0 R /F27 441 0 R /F30 611 0 R >> /ProcSet [ /PDF /Text ] >> endobj -859 0 obj << +884 0 obj << /Length 7526 >> stream @@ -8056,63 +8281,63 @@ BT 0 g 0 G [(.)-445(The)-333(rank)-333(of)]TJ/F11 9.9626 Tf 111.001 0 Td [(x)]TJ/F8 9.9626 Tf 9.014 0 Td [(m)28(ust)-334(b)-27(e)-334(the)-333(same)-334(of)]TJ/F11 9.9626 Tf 91.712 0 Td [(y)]TJ/F8 9.9626 Tf 5.242 0 Td [(.)]TJ 0 g 0 G - -75.001 -29.888 Td [(35)]TJ + -75.001 -29.888 Td [(37)]TJ 0 g 0 G ET endstream endobj -858 0 obj << +883 0 obj << /Type /Page -/Contents 859 0 R -/Resources 857 0 R +/Contents 884 0 R +/Resources 882 0 R /MediaBox [0 0 595.276 841.89] -/Parent 830 0 R -/Annots [ 853 0 R 854 0 R 855 0 R ] +/Parent 890 0 R +/Annots [ 878 0 R 879 0 R 880 0 R ] >> endobj -853 0 obj << +878 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [382.088 263.462 394.043 274.311] /Subtype /Link /A << /S /GoTo /D (table.11) >> >> endobj -854 0 obj << +879 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [294.721 196.128 367.009 207.253] /Subtype /Link /A << /S /GoTo /D (spdata) >> >> endobj -855 0 obj << +880 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [162.826 117.392 174.781 128.24] /Subtype /Link /A << /S /GoTo /D (table.11) >> >> endobj -860 0 obj << -/D [858 0 R /XYZ 99.895 740.998 null] +885 0 obj << +/D [883 0 R /XYZ 99.895 740.998 null] >> endobj -146 0 obj << -/D [858 0 R /XYZ 99.895 697.37 null] +154 0 obj << +/D [883 0 R /XYZ 99.895 697.37 null] >> endobj -861 0 obj << -/D [858 0 R /XYZ 229.172 675.784 null] +886 0 obj << +/D [883 0 R /XYZ 229.172 675.784 null] >> endobj -862 0 obj << -/D [858 0 R /XYZ 226.034 658.884 null] +887 0 obj << +/D [883 0 R /XYZ 226.034 658.884 null] >> endobj -863 0 obj << -/D [858 0 R /XYZ 225.394 641.984 null] +888 0 obj << +/D [883 0 R /XYZ 225.394 641.984 null] >> endobj -864 0 obj << -/D [858 0 R /XYZ 270.132 440.216 null] +889 0 obj << +/D [883 0 R /XYZ 270.132 440.216 null] >> endobj -857 0 obj << -/Font << /F16 431 0 R /F8 434 0 R /F11 587 0 R /F14 604 0 R /F10 603 0 R /F7 602 0 R /F27 433 0 R /F30 601 0 R >> +882 0 obj << +/Font << /F16 439 0 R /F8 442 0 R /F11 597 0 R /F14 614 0 R /F10 613 0 R /F7 612 0 R /F27 441 0 R /F30 611 0 R >> /ProcSet [ /PDF /Text ] >> endobj -873 0 obj << +899 0 obj << /Length 6469 >> stream @@ -8210,76 +8435,76 @@ BT 0 g 0 G /F8 9.9626 Tf 23.758 0 Td [(Error)-333(co)-28(de.)]TJ 1.148 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.612 0 Td [(required)]TJ/F8 9.9626 Tf -29.612 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(out)]TJ/F8 9.9626 Tf 16.549 0 Td [(.)]TJ -50.035 -11.955 Td [(An)-333(in)28(te)-1(ger)-333(v)56(alue;)-334(0)-333(means)-333(no)-334(error)-333(has)-333(b)-28(een)-333(detec)-1(t)1(e)-1(d.)]TJ 0 g 0 G - 141.968 -40.322 Td [(36)]TJ + 141.968 -40.322 Td [(38)]TJ 0 g 0 G ET endstream endobj -872 0 obj << +898 0 obj << /Type /Page -/Contents 873 0 R -/Resources 871 0 R +/Contents 899 0 R +/Resources 897 0 R /MediaBox [0 0 595.276 841.89] -/Parent 830 0 R -/Annots [ 856 0 R 865 0 R 866 0 R 867 0 R 868 0 R 869 0 R 870 0 R ] +/Parent 890 0 R +/Annots [ 881 0 R 891 0 R 892 0 R 893 0 R 894 0 R 895 0 R 896 0 R ] >> endobj -856 0 obj << +881 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [432.897 655.375 444.852 666.223] /Subtype /Link /A << /S /GoTo /D (table.11) >> >> endobj -865 0 obj << +891 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [213.636 576.26 225.591 587.108] /Subtype /Link /A << /S /GoTo /D (table.11) >> >> endobj -866 0 obj << +892 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [345.53 508.823 412.588 519.948] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -867 0 obj << +893 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [397.199 470.422 404.172 481.27] /Subtype /Link /A << /S /GoTo /D (equation.1) >> >> endobj -868 0 obj << +894 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [396.202 455.068 403.176 465.916] /Subtype /Link /A << /S /GoTo /D (equation.2) >> >> endobj -869 0 obj << +895 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [396.507 439.714 403.481 450.563] /Subtype /Link /A << /S /GoTo /D (equation.3) >> >> endobj -870 0 obj << +896 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [253.818 194.986 265.774 205.834] /Subtype /Link /A << /S /GoTo /D (table.11) >> >> endobj -874 0 obj << -/D [872 0 R /XYZ 150.705 740.998 null] +900 0 obj << +/D [898 0 R /XYZ 150.705 740.998 null] >> endobj -871 0 obj << -/Font << /F27 433 0 R /F8 434 0 R /F11 587 0 R /F30 601 0 R >> +897 0 obj << +/Font << /F27 441 0 R /F8 442 0 R /F11 597 0 R /F30 611 0 R >> /ProcSet [ /PDF /Text ] >> endobj -879 0 obj << +905 0 obj << /Length 8409 >> stream @@ -8388,40 +8613,40 @@ BT 0 g 0 G [(.)]TJ 0 g 0 G - 141.968 -29.888 Td [(37)]TJ + 141.968 -29.888 Td [(39)]TJ 0 g 0 G ET endstream endobj -878 0 obj << +904 0 obj << /Type /Page -/Contents 879 0 R -/Resources 877 0 R +/Contents 905 0 R +/Resources 903 0 R /MediaBox [0 0 595.276 841.89] -/Parent 882 0 R -/Annots [ 875 0 R ] +/Parent 890 0 R +/Annots [ 901 0 R ] >> endobj -875 0 obj << +901 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [382.088 117.392 394.043 128.24] /Subtype /Link /A << /S /GoTo /D (table.12) >> >> endobj -880 0 obj << -/D [878 0 R /XYZ 99.895 740.998 null] +906 0 obj << +/D [904 0 R /XYZ 99.895 740.998 null] >> endobj -150 0 obj << -/D [878 0 R /XYZ 99.895 697.37 null] +158 0 obj << +/D [904 0 R /XYZ 99.895 697.37 null] >> endobj -881 0 obj << -/D [878 0 R /XYZ 270.132 252.928 null] +907 0 obj << +/D [904 0 R /XYZ 270.132 252.928 null] >> endobj -877 0 obj << -/Font << /F16 431 0 R /F8 434 0 R /F11 587 0 R /F14 604 0 R /F10 603 0 R /F13 851 0 R /F7 602 0 R /F30 601 0 R /F27 433 0 R >> +903 0 obj << +/Font << /F16 439 0 R /F8 442 0 R /F11 597 0 R /F14 614 0 R /F10 613 0 R /F13 876 0 R /F7 612 0 R /F30 611 0 R /F27 441 0 R >> /ProcSet [ /PDF /Text ] >> endobj -889 0 obj << +914 0 obj << /Length 6773 >> stream @@ -8522,62 +8747,62 @@ BT 0 g 0 G /F8 9.9626 Tf 63.221 0 Td [(the)-333(op)-28(eration)-333(is)-334(with)-333(righ)28(t)-333(sc)-1(al)1(ing.)]TJ 0 g 0 G - 78.746 -29.888 Td [(38)]TJ + 78.746 -29.888 Td [(40)]TJ 0 g 0 G ET endstream endobj -888 0 obj << +913 0 obj << /Type /Page -/Contents 889 0 R -/Resources 887 0 R +/Contents 914 0 R +/Resources 912 0 R /MediaBox [0 0 595.276 841.89] -/Parent 882 0 R -/Annots [ 876 0 R 883 0 R 884 0 R 885 0 R 886 0 R ] +/Parent 890 0 R +/Annots [ 902 0 R 908 0 R 909 0 R 910 0 R 911 0 R ] >> endobj -876 0 obj << +902 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [393.738 655.375 400.712 666.223] /Subtype /Link /A << /S /GoTo /D (section.3) >> >> endobj -883 0 obj << +908 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [213.636 572.775 225.591 583.624] /Subtype /Link /A << /S /GoTo /D (table.12) >> >> endobj -884 0 obj << +909 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [432.897 502.131 444.852 512.979] /Subtype /Link /A << /S /GoTo /D (table.12) >> >> endobj -885 0 obj << +910 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [213.636 419.532 225.591 430.38] /Subtype /Link /A << /S /GoTo /D (table.12) >> >> endobj -886 0 obj << +911 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [345.53 348.611 412.588 359.736] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -890 0 obj << -/D [888 0 R /XYZ 150.705 740.998 null] +915 0 obj << +/D [913 0 R /XYZ 150.705 740.998 null] >> endobj -887 0 obj << -/Font << /F27 433 0 R /F8 434 0 R /F11 587 0 R /F14 604 0 R /F30 601 0 R /F17 573 0 R >> +912 0 obj << +/Font << /F27 441 0 R /F8 442 0 R /F11 597 0 R /F14 614 0 R /F30 611 0 R /F17 583 0 R >> /ProcSet [ /PDF /Text ] >> endobj -895 0 obj << +920 0 obj << /Length 4663 >> stream @@ -8629,41 +8854,41 @@ BT 0 g 0 G /F8 9.9626 Tf 23.758 0 Td [(Error)-333(co)-28(de.)]TJ 1.149 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.956 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf -29.611 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(out)]TJ/F8 9.9626 Tf 16.549 0 Td [(.)]TJ -50.035 -11.955 Td [(An)-333(in)28(tege)-1(r)-333(v)56(alue;)-334(0)-333(means)-333(no)-334(error)-333(has)-333(b)-28(een)-333(detecte)-1(d)1(.)]TJ 0 g 0 G - 141.968 -73.723 Td [(39)]TJ + 141.968 -73.723 Td [(41)]TJ 0 g 0 G ET endstream endobj -894 0 obj << +919 0 obj << /Type /Page -/Contents 895 0 R -/Resources 893 0 R +/Contents 920 0 R +/Resources 918 0 R /MediaBox [0 0 595.276 841.89] -/Parent 882 0 R -/Annots [ 891 0 R 892 0 R ] +/Parent 890 0 R +/Annots [ 916 0 R 917 0 R ] >> endobj -891 0 obj << +916 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [162.826 410.238 174.781 419.149] /Subtype /Link /A << /S /GoTo /D (table.12) >> >> endobj -892 0 obj << +917 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [203.009 228.974 214.964 239.822] /Subtype /Link /A << /S /GoTo /D (table.12) >> >> endobj -896 0 obj << -/D [894 0 R /XYZ 99.895 740.998 null] +921 0 obj << +/D [919 0 R /XYZ 99.895 740.998 null] >> endobj -893 0 obj << -/Font << /F8 434 0 R /F27 433 0 R /F11 587 0 R /F30 601 0 R >> +918 0 obj << +/Font << /F8 442 0 R /F27 441 0 R /F11 597 0 R /F30 611 0 R >> /ProcSet [ /PDF /Text ] >> endobj -900 0 obj << +925 0 obj << /Length 651 >> stream @@ -8676,37 +8901,37 @@ BT 0 g 0 G [(.)]TJ 0 g 0 G - 166.874 -569.96 Td [(40)]TJ + 166.874 -569.96 Td [(42)]TJ 0 g 0 G ET endstream endobj -899 0 obj << +924 0 obj << /Type /Page -/Contents 900 0 R -/Resources 898 0 R +/Contents 925 0 R +/Resources 923 0 R /MediaBox [0 0 595.276 841.89] -/Parent 882 0 R -/Annots [ 897 0 R ] +/Parent 890 0 R +/Annots [ 922 0 R ] >> endobj -897 0 obj << +922 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [350.345 657.464 357.319 668.312] /Subtype /Link /A << /S /GoTo /D (section.6) >> >> endobj -901 0 obj << -/D [899 0 R /XYZ 150.705 740.998 null] +926 0 obj << +/D [924 0 R /XYZ 150.705 740.998 null] >> endobj -154 0 obj << -/D [899 0 R /XYZ 150.705 716.092 null] +162 0 obj << +/D [924 0 R /XYZ 150.705 716.092 null] >> endobj -898 0 obj << -/Font << /F16 431 0 R /F8 434 0 R >> +923 0 obj << +/Font << /F16 439 0 R /F8 442 0 R >> /ProcSet [ /PDF /Text ] >> endobj -907 0 obj << +932 0 obj << /Length 6023 >> stream @@ -8847,54 +9072,54 @@ BT 0 g 0 G /F8 9.9626 Tf 29.432 0 Td [(the)-333(w)27(ork)-333(arra)28(y)83(.)]TJ -4.525 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(optional)]TJ/F8 9.9626 Tf -29.611 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(inout)]TJ/F8 9.9626 Tf 26.096 0 Td [(.)]TJ -59.582 -11.955 Td [(Sp)-28(eci\014ed)-348(as:)-475(a)-349(rank)-348(one)-349(arra)28(y)-349(of)-348(the)-349(same)-348(t)27(yp)-27(e)-349(of)]TJ/F11 9.9626 Tf 222.576 0 Td [(x)]TJ/F8 9.9626 Tf 9.167 0 Td [(with)-349(th)1(e)-349(POINTER)]TJ -231.743 -11.955 Td [(attribute.)]TJ 0 g 0 G - 141.968 -29.888 Td [(41)]TJ + 141.968 -29.888 Td [(43)]TJ 0 g 0 G ET endstream endobj -906 0 obj << +931 0 obj << /Type /Page -/Contents 907 0 R -/Resources 905 0 R +/Contents 932 0 R +/Resources 930 0 R /MediaBox [0 0 595.276 841.89] -/Parent 882 0 R -/Annots [ 902 0 R 903 0 R 904 0 R ] +/Parent 935 0 R +/Annots [ 927 0 R 928 0 R 929 0 R ] >> endobj -902 0 obj << +927 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [310.744 340.904 322.699 351.753] /Subtype /Link /A << /S /GoTo /D (table.13) >> >> endobj -903 0 obj << +928 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [294.721 274.094 361.779 285.219] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -904 0 obj << +929 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [382.088 195.881 394.043 206.73] /Subtype /Link /A << /S /GoTo /D (table.13) >> >> endobj -908 0 obj << -/D [906 0 R /XYZ 99.895 740.998 null] +933 0 obj << +/D [931 0 R /XYZ 99.895 740.998 null] >> endobj -158 0 obj << -/D [906 0 R /XYZ 99.895 697.37 null] +166 0 obj << +/D [931 0 R /XYZ 99.895 697.37 null] >> endobj -909 0 obj << -/D [906 0 R /XYZ 270.132 513.469 null] +934 0 obj << +/D [931 0 R /XYZ 270.132 513.469 null] >> endobj -905 0 obj << -/Font << /F16 431 0 R /F8 434 0 R /F11 587 0 R /F14 604 0 R /F27 433 0 R /F30 601 0 R >> +930 0 obj << +/Font << /F16 439 0 R /F8 442 0 R /F11 597 0 R /F14 614 0 R /F27 441 0 R /F30 611 0 R >> /ProcSet [ /PDF /Text ] >> endobj -915 0 obj << +941 0 obj << /Length 4119 >> stream @@ -8938,43 +9163,43 @@ Q 0 g 0 G 1 0 0 1 -210.961 -455.126 cm BT -/F8 9.9626 Tf 240.078 231.087 Td [(Figure)-333(6:)-445(Sample)-333(discretization)-333(mesh.)]TJ +/F8 9.9626 Tf 240.078 231.087 Td [(Figure)-333(7:)-445(Sample)-333(discretization)-333(mesh.)]TJ 0 g 0 G 0 g 0 G /F16 11.9552 Tf -89.373 -23.91 Td [(Usage)-381(Example)]TJ/F8 9.9626 Tf 93.98 0 Td [(Consider)-338(the)-339(discretization)-338(mesh)-339(depicted)-338(in)-338(\014g.)]TJ 0 0 1 rg 0 0 1 RG - [-339(6)]TJ + [-339(7)]TJ 0 g 0 G [(,)-339(parti-)]TJ -93.98 -11.955 Td [(tioned)-334(among)-334(t)27(w)28(o)-334(pro)-28(cesses)-334(as)-335(sho)28(wn)-334(b)28(y)-334(the)-335(dashed)-334(line;)-334(the)-335(data)-334(distribution)]TJ 0 -11.955 Td [(is)-422(suc)28(h)-422(that)-422(eac)28(h)-422(pro)-28(cess)-422(will)-421(o)27(wn)-422(32)-421(en)27(tries)-421(in)-422(the)-422(index)-422(space,)-444(with)-422(a)-422(halo)]TJ 0 -11.955 Td [(made)-340(of)-341(8)-340(en)28(tries)-341(placed)-340(at)-340(lo)-28(cal)-341(in)1(dices)-341(33)-340(through)-340(40.)-466(If)-340(pro)-28(cess)-341(0)-340(assigns)-340(an)]TJ 0 -11.956 Td [(initial)-423(v)55(alue)-423(of)-424(1)-423(to)-424(its)-423(en)28(tries)-424(in)-423(the)]TJ/F11 9.9626 Tf 169.005 0 Td [(x)]TJ/F8 9.9626 Tf 9.913 0 Td [(v)28(ector,)-446(and)-424(pro)-27(cess)-424(1)-423(ass)-1(i)1(g)-1(n)1(s)-424(a)-423(v)55(alue)]TJ -178.918 -11.955 Td [(of)-349(2,)-353(then)-349(after)-349(a)-349(call)-349(to)]TJ/F30 9.9626 Tf 108.539 0 Td [(psb_halo)]TJ/F8 9.9626 Tf 45.32 0 Td [(the)-349(con)28(ten)27(t)1(s)-350(of)-349(the)-349(lo)-27(cal)-350(v)28(ectors)-349(will)-349(b)-28(e)-349(the)]TJ -153.859 -11.955 Td [(follo)28(wing:)]TJ 0 g 0 G - 166.874 -45.008 Td [(42)]TJ + 166.874 -45.008 Td [(44)]TJ 0 g 0 G ET endstream endobj -914 0 obj << +940 0 obj << /Type /Page -/Contents 915 0 R -/Resources 913 0 R +/Contents 941 0 R +/Resources 939 0 R /MediaBox [0 0 595.276 841.89] -/Parent 882 0 R -/Annots [ 910 0 R 912 0 R ] +/Parent 935 0 R +/Annots [ 936 0 R 938 0 R ] >> endobj -911 0 obj << +937 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./figures/try8x8.pdf) /PTEX.PageNumber 1 -/PTEX.InfoDict 918 0 R +/PTEX.InfoDict 944 0 R /BBox [0 0 436 496] /Resources << /ProcSet [ /PDF /Text ] /ExtGState << -/R7 919 0 R ->>/Font << /R8 920 0 R/R9 921 0 R>> +/R7 945 0 R +>>/Font << /R8 946 0 R/R9 947 0 R>> >> -/Length 922 0 R +/Length 948 0 R /Filter /FlateDecode >> stream @@ -8990,62 +9215,62 @@ QI* d)eI%�}QÉ'?+ä°~I*écÂ\‚?XO#~Ã[!©äX‚?fJÇüÁaî‹J8ù9â÷%©¤� s‰ù`=�ø Ÿ�× ,ªƒ1Œ�|?ª$6ŠázžAª@}¡J¢¿R©’#‡z|]ñd•9ÔãýL G„z8¯—÷¬’Ï€äcD¾P%ùàgÌcå‘#<¾®x²J2³jˆÏÕpD„ó¢¼g•mø»ãoÇßþžŸúö§Ç6Úë¸w¶�W~ûùñéØ?ûçãK߯åÌÞ>Øíƒ]?Øeµûü`ŸìqÛ{éÏ/m;±ù"×~¢WëÖëj¾Z…3lï²ÛÂ?|�Ïz¼Ú½m[{힦„iÿb¬m»¦øóe•Ï¿{üáÛã¯×¿ÿ-3‡à endstream endobj -918 0 obj +944 0 obj << /Producer (ESP Ghostscript 815.03) /CreationDate (D:20070118112257) /ModDate (D:20070118112257) >> endobj -919 0 obj +945 0 obj << /Type /ExtGState /OPM 1 >> endobj -920 0 obj +946 0 obj << /BaseFont /Times-Roman /Type /Font /Subtype /Type1 >> endobj -921 0 obj +947 0 obj << /BaseFont /Times-Bold /Type /Font /Subtype /Type1 >> endobj -922 0 obj +948 0 obj 3571 endobj -910 0 obj << +936 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [213.636 545.73 225.591 554.641] /Subtype /Link /A << /S /GoTo /D (table.13) >> >> endobj -912 0 obj << +938 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [457.906 203.856 464.88 216.476] /Subtype /Link -/A << /S /GoTo /D (figure.6) >> +/A << /S /GoTo /D (figure.7) >> >> endobj -916 0 obj << -/D [914 0 R /XYZ 150.705 740.998 null] +942 0 obj << +/D [940 0 R /XYZ 150.705 740.998 null] >> endobj -917 0 obj << -/D [914 0 R /XYZ 283.692 243.043 null] +943 0 obj << +/D [940 0 R /XYZ 283.692 243.043 null] >> endobj -913 0 obj << -/Font << /F27 433 0 R /F8 434 0 R /F30 601 0 R /F11 587 0 R /F16 431 0 R >> -/XObject << /Im3 911 0 R >> +939 0 obj << +/Font << /F27 441 0 R /F8 442 0 R /F30 611 0 R /F11 597 0 R /F16 439 0 R >> +/XObject << /Im3 937 0 R >> /ProcSet [ /PDF /Text ] >> endobj -925 0 obj << +951 0 obj << /Length 3050 >> stream @@ -9058,26 +9283,26 @@ BT /F45 8.9664 Tf 205.966 645.656 Td [(Pro)-29(cess)-342(0)-8224(Pro)-28(cess)-343(1)]TJ -33.967 -10.959 Td [(I)-1333(GLOB\050I\051)-1334(X\050I\051)-4656(I)-1334(GLOB\050I\051)-1333(X\050I\051)]TJ -1.281 -10.959 Td [(1)-4966(1)-1961(1.0)-4514(1)-4452(33)-1961(2.0)]TJ 0 -10.959 Td [(2)-4966(2)-1961(1.0)-4514(2)-4452(34)-1961(2.0)]TJ 0 -10.959 Td [(3)-4966(3)-1961(1.0)-4514(3)-4452(35)-1961(2.0)]TJ 0 -10.959 Td [(4)-4966(4)-1961(1.0)-4514(4)-4452(36)-1961(2.0)]TJ 0 -10.959 Td [(5)-4966(5)-1961(1.0)-4514(5)-4452(37)-1961(2.0)]TJ 0 -10.959 Td [(6)-4966(6)-1961(1.0)-4514(6)-4452(38)-1961(2.0)]TJ 0 -10.959 Td [(7)-4966(7)-1961(1.0)-4514(7)-4452(39)-1961(2.0)]TJ 0 -10.958 Td [(8)-4966(8)-1961(1.0)-4514(8)-4452(40)-1961(2.0)]TJ 0 -10.959 Td [(9)-4966(9)-1961(1.0)-4514(9)-4452(41)-1961(2.0)]TJ -4.608 -10.959 Td [(10)-4452(10)-1961(1.0)-4000(10)-4452(42)-1961(2.0)]TJ 0 -10.959 Td [(11)-4452(11)-1961(1.0)-4000(11)-4452(43)-1961(2.0)]TJ 0 -10.959 Td [(12)-4452(12)-1961(1.0)-4000(12)-4452(44)-1961(2.0)]TJ 0 -10.959 Td [(13)-4452(13)-1961(1.0)-4000(13)-4452(45)-1961(2.0)]TJ 0 -10.959 Td [(14)-4452(14)-1961(1.0)-4000(14)-4452(46)-1961(2.0)]TJ 0 -10.959 Td [(15)-4452(15)-1961(1.0)-4000(15)-4452(47)-1961(2.0)]TJ 0 -10.959 Td [(16)-4452(16)-1961(1.0)-4000(16)-4452(48)-1961(2.0)]TJ 0 -10.959 Td [(17)-4452(17)-1961(1.0)-4000(17)-4452(49)-1961(2.0)]TJ 0 -10.958 Td [(18)-4452(18)-1961(1.0)-4000(18)-4452(50)-1961(2.0)]TJ 0 -10.959 Td [(19)-4452(19)-1961(1.0)-4000(19)-4452(51)-1961(2.0)]TJ 0 -10.959 Td [(20)-4452(20)-1961(1.0)-4000(20)-4452(52)-1961(2.0)]TJ 0 -10.959 Td [(21)-4452(21)-1961(1.0)-4000(21)-4452(53)-1961(2.0)]TJ 0 -10.959 Td [(22)-4452(22)-1961(1.0)-4000(22)-4452(54)-1961(2.0)]TJ 0 -10.959 Td [(23)-4452(23)-1961(1.0)-4000(23)-4452(55)-1961(2.0)]TJ 0 -10.959 Td [(24)-4452(24)-1961(1.0)-4000(24)-4452(56)-1961(2.0)]TJ 0 -10.959 Td [(25)-4452(25)-1961(1.0)-4000(25)-4452(57)-1961(2.0)]TJ 0 -10.959 Td [(26)-4452(26)-1961(1.0)-4000(26)-4452(58)-1961(2.0)]TJ 0 -10.959 Td [(27)-4452(27)-1961(1.0)-4000(27)-4452(59)-1961(2.0)]TJ 0 -10.958 Td [(28)-4452(28)-1961(1.0)-4000(28)-4452(60)-1961(2.0)]TJ 0 -10.959 Td [(29)-4452(29)-1961(1.0)-4000(29)-4452(61)-1961(2.0)]TJ 0 -10.959 Td [(30)-4452(30)-1961(1.0)-4000(30)-4452(62)-1961(2.0)]TJ 0 -10.959 Td [(31)-4452(31)-1961(1.0)-4000(31)-4452(63)-1961(2.0)]TJ 0 -10.959 Td [(32)-4452(32)-1961(1.0)-4000(32)-4452(64)-1961(2.0)]TJ 0 -10.959 Td [(33)-4452(33)-1961(2.0)-4000(33)-4452(25)-1961(1.0)]TJ 0 -10.959 Td [(34)-4452(34)-1961(2.0)-4000(34)-4452(26)-1961(1.0)]TJ 0 -10.959 Td [(35)-4452(35)-1961(2.0)-4000(35)-4452(27)-1961(1.0)]TJ 0 -10.959 Td [(36)-4452(36)-1961(2.0)-4000(36)-4452(28)-1961(1.0)]TJ 0 -10.959 Td [(37)-4452(37)-1961(2.0)-4000(37)-4452(29)-1961(1.0)]TJ 0 -10.958 Td [(38)-4452(38)-1961(2.0)-4000(38)-4452(30)-1961(1.0)]TJ 0 -10.959 Td [(39)-4452(39)-1961(2.0)-4000(39)-4452(31)-1961(1.0)]TJ 0 -10.959 Td [(40)-4452(40)-1961(2.0)-4000(40)-4452(32)-1961(1.0)]TJ 0 g 0 G 0 g 0 G -/F8 9.9626 Tf 100.66 -105.903 Td [(43)]TJ +/F8 9.9626 Tf 100.66 -105.903 Td [(45)]TJ 0 g 0 G ET endstream endobj -924 0 obj << +950 0 obj << /Type /Page -/Contents 925 0 R -/Resources 923 0 R +/Contents 951 0 R +/Resources 949 0 R /MediaBox [0 0 595.276 841.89] -/Parent 928 0 R +/Parent 935 0 R >> endobj -926 0 obj << -/D [924 0 R /XYZ 99.895 740.998 null] +952 0 obj << +/D [950 0 R /XYZ 99.895 740.998 null] >> endobj -923 0 obj << -/Font << /F45 927 0 R /F8 434 0 R >> +949 0 obj << +/Font << /F45 953 0 R /F8 442 0 R >> /ProcSet [ /PDF /Text ] >> endobj -933 0 obj << +958 0 obj << /Length 6993 >> stream @@ -9279,47 +9504,47 @@ Q BT /F8 9.9626 Tf 175.611 132.281 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(global)]TJ/F8 9.9626 Tf -32.379 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-445(a)-333(in)28(teger)-333(v)55(ariable.)]TJ 0 g 0 G - 141.968 -29.888 Td [(44)]TJ + 141.968 -29.888 Td [(46)]TJ 0 g 0 G ET endstream endobj -932 0 obj << +957 0 obj << /Type /Page -/Contents 933 0 R -/Resources 931 0 R +/Contents 958 0 R +/Resources 956 0 R /MediaBox [0 0 595.276 841.89] -/Parent 928 0 R -/Annots [ 929 0 R 930 0 R ] +/Parent 935 0 R +/Annots [ 954 0 R 955 0 R ] >> endobj -929 0 obj << +954 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [213.636 334.803 225.591 343.714] /Subtype /Link /A << /S /GoTo /D (table.14) >> >> endobj -930 0 obj << +955 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [345.53 265.461 412.588 276.586] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -934 0 obj << -/D [932 0 R /XYZ 150.705 740.998 null] +959 0 obj << +/D [957 0 R /XYZ 150.705 740.998 null] >> endobj -162 0 obj << -/D [932 0 R /XYZ 150.705 697.37 null] +170 0 obj << +/D [957 0 R /XYZ 150.705 697.37 null] >> endobj -935 0 obj << -/D [932 0 R /XYZ 320.941 510.188 null] +960 0 obj << +/D [957 0 R /XYZ 320.941 510.188 null] >> endobj -931 0 obj << -/Font << /F16 431 0 R /F8 434 0 R /F11 587 0 R /F14 604 0 R /F10 603 0 R /F27 433 0 R /F30 601 0 R >> +956 0 obj << +/Font << /F16 439 0 R /F8 442 0 R /F11 597 0 R /F14 614 0 R /F10 613 0 R /F27 441 0 R /F30 611 0 R >> /ProcSet [ /PDF /Text ] >> endobj -942 0 obj << +967 0 obj << /Length 5866 >> stream @@ -9358,65 +9583,65 @@ BT 0 g 0 G [-500(The)-255(op)-28(erator)]TJ/F11 9.9626 Tf 71.84 0 Td [(P)]TJ/F10 6.9738 Tf 6.397 -1.495 Td [(a)]TJ/F8 9.9626 Tf 7.364 1.495 Td [(p)-28(erforms)-255(a)-256(scaling)-255(on)-256(the)-255(o)28(v)27(erlap)-255(elemen)28(ts)-256(b)28(y)-256(the)-255(amoun)28(t)]TJ -72.871 -11.956 Td [(of)-290(r)1(e)-1(pl)1(ic)-1(ati)1(on;)-305(th)28(us,)-298(when)-290(com)28(bined)-289(with)-290(the)-289(reduction)-290(op)-28(erator,)-298(it)-289(im)-1(p)1(le-)]TJ 0 -11.955 Td [(men)28(ts)-334(the)-333(a)28(v)28(erage)-334(of)-333(replicated)-333(elem)-1(en)28(ts)-333(o)28(v)27(er)-333(all)-333(of)-333(their)-334(instances.)]TJ/F16 11.9552 Tf -24.907 -19.925 Td [(Example)-388(of)-388(use)]TJ/F8 9.9626 Tf 93.469 0 Td [(Consider)-345(the)-344(discretization)-345(mesh)-345(d)1(e)-1(p)1(icte)-1(d)-344(in)-345(\014g.)]TJ 0 0 1 rg 0 0 1 RG - [-344(7)]TJ + [-344(8)]TJ 0 g 0 G [(,)-348(parti-)]TJ -93.469 -11.955 Td [(tioned)-330(among)-330(t)28(w)27(o)-330(pro)-27(c)-1(esses)-330(as)-330(sho)28(wn)-330(b)27(y)-330(the)-330(dashed)-330(lines,)-331(with)-330(an)-330(o)28(v)28(erlap)-330(of)-330(1)]TJ 0 -11.955 Td [(extra)-360(la)28(y)28(er)-360(with)-359(resp)-28(ect)-360(to)-359(the)-360(partition)-359(of)-360(\014g.)]TJ 0 0 1 rg 0 0 1 RG - [-359(6)]TJ + [-359(7)]TJ 0 g 0 G [(;)-373(the)-359(data)-360(distribution)-359(is)-360(suc)28(h)]TJ 0 -11.956 Td [(that)-351(eac)27(h)-351(pro)-28(cess)-351(will)-352(o)28(wn)-351(40)-352(en)28(tries)-351(in)-351(the)-352(index)-351(space,)-356(with)-351(an)-352(o)28(v)28(erlap)-351(of)-352(16)]TJ 0 -11.955 Td [(en)28(tries)-326(placed)-325(a)-1(t)-325(lo)-28(cal)-325(indices)-326(25)-326(through)-325(40;)-328(the)-326(halo)-325(w)-1(il)1(l)-326(run)-326(fr)1(om)-326(lo)-28(cal)-326(in)1(dex)]TJ 0 -11.955 Td [(41)-290(through)-291(lo)-27(cal)-291(index)-290(48..)-430(If)-291(pro)-27(cess)-291(0)-290(assigns)-291(an)-290(initial)-290(v)55(alue)-290(of)-291(1)-290(to)-290(its)-291(en)28(tries)]TJ 0 -11.955 Td [(in)-298(the)]TJ/F11 9.9626 Tf 28.079 0 Td [(x)]TJ/F8 9.9626 Tf 8.663 0 Td [(v)28(ector,)-305(and)-298(pro)-28(cess)-298(1)-298(assigns)-299(a)-298(v)56(alue)-298(of)-298(2,)-305(then)-298(after)-298(a)-298(call)-298(to)]TJ/F30 9.9626 Tf 265.127 0 Td [(psb_ovrl)]TJ/F8 9.9626 Tf -301.869 -11.955 Td [(with)]TJ/F30 9.9626 Tf 22.401 0 Td [(psb_avg_)]TJ/F8 9.9626 Tf 44.871 0 Td [(and)-304(a)-304(call)-304(to)]TJ/F30 9.9626 Tf 56.945 0 Td [(psb_halo_)]TJ/F8 9.9626 Tf 50.101 0 Td [(the)-304(con)28(ten)28(ts)-304(of)-304(the)-304(lo)-28(cal)-304(v)28(ectors)-304(will)-304(b)-28(e)]TJ -174.318 -11.955 Td [(the)-333(follo)27(win)1(g)-334(\050sho)28(wing)-333(a)-334(transition)-333(among)-333(the)-334(t)28(w)28(o)-333(sub)-28(domains\051)]TJ 0 g 0 G - 166.875 -143.462 Td [(45)]TJ + 166.875 -143.462 Td [(47)]TJ 0 g 0 G ET endstream endobj -941 0 obj << +966 0 obj << /Type /Page -/Contents 942 0 R -/Resources 940 0 R +/Contents 967 0 R +/Resources 965 0 R /MediaBox [0 0 595.276 841.89] -/Parent 928 0 R -/Annots [ 936 0 R 938 0 R 939 0 R ] +/Parent 935 0 R +/Annots [ 961 0 R 963 0 R 964 0 R ] >> endobj -936 0 obj << +961 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [203.009 555.748 214.964 566.597] /Subtype /Link /A << /S /GoTo /D (table.14) >> >> endobj -938 0 obj << +963 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [407.019 326.22 413.993 338.84] /Subtype /Link -/A << /S /GoTo /D (figure.7) >> +/A << /S /GoTo /D (figure.8) >> >> endobj -939 0 obj << +964 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [306.759 302.697 313.733 313.546] /Subtype /Link -/A << /S /GoTo /D (figure.6) >> +/A << /S /GoTo /D (figure.7) >> >> endobj -943 0 obj << -/D [941 0 R /XYZ 99.895 740.998 null] +968 0 obj << +/D [966 0 R /XYZ 99.895 740.998 null] >> endobj -944 0 obj << -/D [941 0 R /XYZ 99.895 465.033 null] +969 0 obj << +/D [966 0 R /XYZ 99.895 465.033 null] >> endobj -945 0 obj << -/D [941 0 R /XYZ 99.895 431.215 null] +970 0 obj << +/D [966 0 R /XYZ 99.895 431.215 null] >> endobj -946 0 obj << -/D [941 0 R /XYZ 99.895 387.38 null] +971 0 obj << +/D [966 0 R /XYZ 99.895 387.38 null] >> endobj -940 0 obj << -/Font << /F27 433 0 R /F8 434 0 R /F11 587 0 R /F16 431 0 R /F10 603 0 R /F30 601 0 R >> +965 0 obj << +/Font << /F27 441 0 R /F8 442 0 R /F11 597 0 R /F16 439 0 R /F10 613 0 R /F30 611 0 R >> /ProcSet [ /PDF /Text ] >> endobj -950 0 obj << +975 0 obj << /Length 3619 >> stream @@ -9429,26 +9654,26 @@ BT /F31 7.9701 Tf 260.921 653.177 Td [(Pro)-29(ce)-1(ss)-354(0)-8986(Pro)-30(cess)-354(1)]TJ -33.381 -9.464 Td [(I)-1500(GLOB\050I\051)-1500(X\050I\051)-5180(I)-1500(GLOB\050I\051)-1500(X\050I\051)]TJ -1.185 -9.465 Td [(1)-5253(1)-2148(1)1(.)-1(0)-5031(1)-4722(33)-2147(1.5)]TJ 0 -9.464 Td [(2)-5253(2)-2148(1)1(.)-1(0)-5031(2)-4722(34)-2147(1.5)]TJ 0 -9.465 Td [(3)-5253(3)-2148(1)1(.)-1(0)-5031(3)-4722(35)-2147(1.5)]TJ 0 -9.464 Td [(4)-5253(4)-2148(1)1(.)-1(0)-5031(4)-4722(36)-2147(1.5)]TJ 0 -9.465 Td [(5)-5253(5)-2148(1)1(.)-1(0)-5031(5)-4722(37)-2147(1.5)]TJ 0 -9.464 Td [(6)-5253(6)-2148(1)1(.)-1(0)-5031(6)-4722(38)-2147(1.5)]TJ 0 -9.465 Td [(7)-5253(7)-2148(1)1(.)-1(0)-5031(7)-4722(39)-2147(1.5)]TJ 0 -9.464 Td [(8)-5253(8)-2148(1)1(.)-1(0)-5031(8)-4722(40)-2147(1.5)]TJ 0 -9.465 Td [(9)-5253(9)-2148(1)1(.)-1(0)-5031(9)-4722(41)-2147(2.0)]TJ -4.234 -9.464 Td [(10)-4722(10)-2147(1.0)-4500(10)-4722(42)-2147(2.0)]TJ 0 -9.465 Td [(11)-4722(11)-2147(1.0)-4500(11)-4722(43)-2147(2.0)]TJ 0 -9.464 Td [(12)-4722(12)-2147(1.0)-4500(12)-4722(44)-2147(2.0)]TJ 0 -9.465 Td [(13)-4722(13)-2147(1.0)-4500(13)-4722(45)-2147(2.0)]TJ 0 -9.464 Td [(14)-4722(14)-2147(1.0)-4500(14)-4722(46)-2147(2.0)]TJ 0 -9.465 Td [(15)-4722(15)-2147(1.0)-4500(15)-4722(47)-2147(2.0)]TJ 0 -9.464 Td [(16)-4722(16)-2147(1.0)-4500(16)-4722(48)-2147(2.0)]TJ 0 -9.465 Td [(17)-4722(17)-2147(1.0)-4500(17)-4722(49)-2147(2.0)]TJ 0 -9.464 Td [(18)-4722(18)-2147(1.0)-4500(18)-4722(50)-2147(2.0)]TJ 0 -9.465 Td [(19)-4722(19)-2147(1.0)-4500(19)-4722(51)-2147(2.0)]TJ 0 -9.464 Td [(20)-4722(20)-2147(1.0)-4500(20)-4722(52)-2147(2.0)]TJ 0 -9.465 Td [(21)-4722(21)-2147(1.0)-4500(21)-4722(53)-2147(2.0)]TJ 0 -9.464 Td [(22)-4722(22)-2147(1.0)-4500(22)-4722(54)-2147(2.0)]TJ 0 -9.465 Td [(23)-4722(23)-2147(1.0)-4500(23)-4722(55)-2147(2.0)]TJ 0 -9.464 Td [(24)-4722(24)-2147(1.0)-4500(24)-4722(56)-2147(2.0)]TJ 0 -9.465 Td [(25)-4722(25)-2147(1.5)-4500(25)-4722(57)-2147(2.0)]TJ 0 -9.464 Td [(26)-4722(26)-2147(1.5)-4500(26)-4722(58)-2147(2.0)]TJ 0 -9.465 Td [(27)-4722(27)-2147(1.5)-4500(27)-4722(59)-2147(2.0)]TJ 0 -9.464 Td [(28)-4722(28)-2147(1.5)-4500(28)-4722(60)-2147(2.0)]TJ 0 -9.465 Td [(29)-4722(29)-2147(1.5)-4500(29)-4722(61)-2147(2.0)]TJ 0 -9.464 Td [(30)-4722(30)-2147(1.5)-4500(30)-4722(62)-2147(2.0)]TJ 0 -9.465 Td [(31)-4722(31)-2147(1.5)-4500(31)-4722(63)-2147(2.0)]TJ 0 -9.464 Td [(32)-4722(32)-2147(1.5)-4500(32)-4722(64)-2147(2.0)]TJ 0 -9.465 Td [(33)-4722(33)-2147(1.5)-4500(33)-4722(25)-2147(1.5)]TJ 0 -9.464 Td [(34)-4722(34)-2147(1.5)-4500(34)-4722(26)-2147(1.5)]TJ 0 -9.465 Td [(35)-4722(35)-2147(1.5)-4500(35)-4722(27)-2147(1.5)]TJ 0 -9.464 Td [(36)-4722(36)-2147(1.5)-4500(36)-4722(28)-2147(1.5)]TJ 0 -9.465 Td [(37)-4722(37)-2147(1.5)-4500(37)-4722(29)-2147(1.5)]TJ 0 -9.464 Td [(38)-4722(38)-2147(1.5)-4500(38)-4722(30)-2147(1.5)]TJ 0 -9.465 Td [(39)-4722(39)-2147(1.5)-4500(39)-4722(31)-2147(1.5)]TJ 0 -9.464 Td [(40)-4722(40)-2147(1.5)-4500(40)-4722(32)-2147(1.5)]TJ 0 -9.465 Td [(41)-4722(41)-2147(2.0)-4500(41)-4722(17)-2147(1.0)]TJ 0 -9.464 Td [(42)-4722(42)-2147(2.0)-4500(42)-4722(18)-2147(1.0)]TJ 0 -9.465 Td [(43)-4722(43)-2147(2.0)-4500(43)-4722(19)-2147(1.0)]TJ 0 -9.464 Td [(44)-4722(44)-2147(2.0)-4500(44)-4722(20)-2147(1.0)]TJ 0 -9.465 Td [(45)-4722(45)-2147(2.0)-4500(45)-4722(21)-2147(1.0)]TJ 0 -9.464 Td [(46)-4722(46)-2147(2.0)-4500(46)-4722(22)-2147(1.0)]TJ 0 -9.465 Td [(47)-4722(47)-2147(2.0)-4500(47)-4722(23)-2147(1.0)]TJ 0 -9.464 Td [(48)-4722(48)-2147(2.0)-4500(48)-4722(24)-2147(1.0)]TJ 0 g 0 G 0 g 0 G -/F8 9.9626 Tf 95.458 -98.979 Td [(46)]TJ +/F8 9.9626 Tf 95.458 -98.979 Td [(48)]TJ 0 g 0 G ET endstream endobj -949 0 obj << +974 0 obj << /Type /Page -/Contents 950 0 R -/Resources 948 0 R +/Contents 975 0 R +/Resources 973 0 R /MediaBox [0 0 595.276 841.89] -/Parent 928 0 R +/Parent 935 0 R >> endobj -951 0 obj << -/D [949 0 R /XYZ 150.705 740.998 null] +976 0 obj << +/D [974 0 R /XYZ 150.705 740.998 null] >> endobj -948 0 obj << -/Font << /F31 607 0 R /F8 434 0 R >> +973 0 obj << +/Font << /F31 617 0 R /F8 442 0 R >> /ProcSet [ /PDF /Text ] >> endobj -954 0 obj << +979 0 obj << /Length 347 >> stream @@ -9471,37 +9696,37 @@ Q 0 g 0 G 1 0 0 1 -104.703 -574.795 cm BT -/F8 9.9626 Tf 189.268 263.559 Td [(Figure)-333(7:)-445(Sample)-333(discretization)-333(mes)-1(h)1(.)]TJ +/F8 9.9626 Tf 189.268 263.559 Td [(Figure)-333(8:)-445(Sample)-333(discretization)-333(mes)-1(h)1(.)]TJ 0 g 0 G 0 g 0 G 0 g 0 G - 77.502 -173.121 Td [(47)]TJ + 77.502 -173.121 Td [(49)]TJ 0 g 0 G ET endstream endobj -953 0 obj << +978 0 obj << /Type /Page -/Contents 954 0 R -/Resources 952 0 R +/Contents 979 0 R +/Resources 977 0 R /MediaBox [0 0 595.276 841.89] -/Parent 928 0 R +/Parent 981 0 R >> endobj -937 0 obj << +962 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./figures/try8x8_ov.pdf) /PTEX.PageNumber 1 -/PTEX.InfoDict 956 0 R +/PTEX.InfoDict 982 0 R /BBox [0 0 436 514] /Resources << /ProcSet [ /PDF /Text ] /ExtGState << -/R7 957 0 R ->>/Font << /R8 958 0 R/R9 959 0 R>> +/R7 983 0 R +>>/Font << /R8 984 0 R/R9 985 0 R>> >> -/Length 960 0 R +/Length 986 0 R /Filter /FlateDecode >> stream @@ -9515,48 +9740,48 @@ V óá!Zäÿ/L)ÇÇ8ú:ß=þ êë¼® endstream endobj -956 0 obj +982 0 obj << /Producer (ESP Ghostscript 815.03) /CreationDate (D:20070118114343) /ModDate (D:20070118114343) >> endobj -957 0 obj +983 0 obj << /Type /ExtGState /OPM 1 >> endobj -958 0 obj +984 0 obj << /BaseFont /Times-Roman /Type /Font /Subtype /Type1 >> endobj -959 0 obj +985 0 obj << /BaseFont /Times-Bold /Type /Font /Subtype /Type1 >> endobj -960 0 obj +986 0 obj 3652 endobj -955 0 obj << -/D [953 0 R /XYZ 99.895 740.998 null] +980 0 obj << +/D [978 0 R /XYZ 99.895 740.998 null] >> endobj -947 0 obj << -/D [953 0 R /XYZ 232.883 275.514 null] +972 0 obj << +/D [978 0 R /XYZ 232.883 275.514 null] >> endobj -952 0 obj << -/Font << /F8 434 0 R >> -/XObject << /Im4 937 0 R >> +977 0 obj << +/Font << /F8 442 0 R >> +/XObject << /Im4 962 0 R >> /ProcSet [ /PDF /Text ] >> endobj -965 0 obj << +991 0 obj << /Length 7588 >> stream @@ -9749,47 +9974,47 @@ BT /F27 9.9626 Tf -299.782 -19.6 Td [(On)-383(Return)]TJ 0 g 0 G 0 g 0 G -/F8 9.9626 Tf 166.874 -29.888 Td [(48)]TJ +/F8 9.9626 Tf 166.874 -29.888 Td [(50)]TJ 0 g 0 G ET endstream endobj -964 0 obj << +990 0 obj << /Type /Page -/Contents 965 0 R -/Resources 963 0 R +/Contents 991 0 R +/Resources 989 0 R /MediaBox [0 0 595.276 841.89] -/Parent 928 0 R -/Annots [ 961 0 R 962 0 R ] +/Parent 981 0 R +/Annots [ 987 0 R 988 0 R ] >> endobj -961 0 obj << +987 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [256.807 285.728 268.762 294.639] /Subtype /Link /A << /S /GoTo /D (table.15) >> >> endobj -962 0 obj << +988 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [345.53 216.093 412.588 227.218] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -966 0 obj << -/D [964 0 R /XYZ 150.705 740.998 null] +992 0 obj << +/D [990 0 R /XYZ 150.705 740.998 null] >> endobj -166 0 obj << -/D [964 0 R /XYZ 150.705 697.37 null] +174 0 obj << +/D [990 0 R /XYZ 150.705 697.37 null] >> endobj -967 0 obj << -/D [964 0 R /XYZ 320.941 465.393 null] +993 0 obj << +/D [990 0 R /XYZ 320.941 465.393 null] >> endobj -963 0 obj << -/Font << /F16 431 0 R /F8 434 0 R /F11 587 0 R /F14 604 0 R /F10 603 0 R /F7 602 0 R /F27 433 0 R /F30 601 0 R >> +989 0 obj << +/Font << /F16 439 0 R /F8 442 0 R /F11 597 0 R /F14 614 0 R /F10 613 0 R /F7 612 0 R /F27 441 0 R /F30 611 0 R >> /ProcSet [ /PDF /Text ] >> endobj -970 0 obj << +996 0 obj << /Length 1355 >> stream @@ -9812,26 +10037,26 @@ BT 0 g 0 G /F8 9.9626 Tf 23.758 0 Td [(Error)-333(co)-28(de.)]TJ 1.149 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf -29.611 -11.956 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(out)]TJ/F8 9.9626 Tf 16.549 0 Td [(.)]TJ -50.035 -11.955 Td [(An)-333(in)28(tege)-1(r)-333(v)56(alue;)-334(0)-333(means)-333(no)-334(error)-333(has)-333(b)-28(een)-333(detecte)-1(d)1(.)]TJ 0 g 0 G - 141.968 -500.124 Td [(49)]TJ + 141.968 -500.124 Td [(51)]TJ 0 g 0 G ET endstream endobj -969 0 obj << +995 0 obj << /Type /Page -/Contents 970 0 R -/Resources 968 0 R +/Contents 996 0 R +/Resources 994 0 R /MediaBox [0 0 595.276 841.89] -/Parent 972 0 R +/Parent 981 0 R >> endobj -971 0 obj << -/D [969 0 R /XYZ 99.895 740.998 null] +997 0 obj << +/D [995 0 R /XYZ 99.895 740.998 null] >> endobj -968 0 obj << -/Font << /F27 433 0 R /F8 434 0 R >> +994 0 obj << +/Font << /F27 441 0 R /F8 442 0 R >> /ProcSet [ /PDF /Text ] >> endobj -977 0 obj << +1002 0 obj << /Length 7211 >> stream @@ -10013,40 +10238,40 @@ BT /F27 9.9626 Tf -299.782 -20.278 Td [(On)-383(Return)]TJ 0 g 0 G 0 g 0 G -/F8 9.9626 Tf 166.874 -29.888 Td [(50)]TJ +/F8 9.9626 Tf 166.874 -29.888 Td [(52)]TJ 0 g 0 G ET endstream endobj -976 0 obj << +1001 0 obj << /Type /Page -/Contents 977 0 R -/Resources 975 0 R +/Contents 1002 0 R +/Resources 1000 0 R /MediaBox [0 0 595.276 841.89] -/Parent 972 0 R -/Annots [ 973 0 R ] +/Parent 981 0 R +/Annots [ 998 0 R ] >> endobj -973 0 obj << +998 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [345.53 217.448 412.588 228.573] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -978 0 obj << -/D [976 0 R /XYZ 150.705 740.998 null] +1003 0 obj << +/D [1001 0 R /XYZ 150.705 740.998 null] >> endobj -170 0 obj << -/D [976 0 R /XYZ 150.705 697.294 null] +178 0 obj << +/D [1001 0 R /XYZ 150.705 697.294 null] >> endobj -979 0 obj << -/D [976 0 R /XYZ 320.941 459.569 null] +1004 0 obj << +/D [1001 0 R /XYZ 320.941 459.569 null] >> endobj -975 0 obj << -/Font << /F16 431 0 R /F8 434 0 R /F11 587 0 R /F10 603 0 R /F14 604 0 R /F7 602 0 R /F27 433 0 R /F30 601 0 R >> +1000 0 obj << +/Font << /F16 439 0 R /F8 442 0 R /F11 597 0 R /F10 613 0 R /F14 614 0 R /F7 612 0 R /F27 441 0 R /F30 611 0 R >> /ProcSet [ /PDF /Text ] >> endobj -982 0 obj << +1007 0 obj << /Length 1718 >> stream @@ -10080,34 +10305,34 @@ BT 0 g 0 G /F8 9.9626 Tf 23.758 0 Td [(Error)-333(co)-28(de.)]TJ 1.149 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.956 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf -29.611 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(out)]TJ/F8 9.9626 Tf 16.549 0 Td [(.)]TJ -50.035 -11.955 Td [(An)-333(in)28(tege)-1(r)-333(v)56(alue;)-334(0)-333(means)-333(no)-334(error)-333(has)-333(b)-28(een)-333(detecte)-1(d)1(.)]TJ 0 g 0 G - 141.968 -488.169 Td [(51)]TJ + 141.968 -488.169 Td [(53)]TJ 0 g 0 G ET endstream endobj -981 0 obj << +1006 0 obj << /Type /Page -/Contents 982 0 R -/Resources 980 0 R +/Contents 1007 0 R +/Resources 1005 0 R /MediaBox [0 0 595.276 841.89] -/Parent 972 0 R -/Annots [ 974 0 R ] +/Parent 981 0 R +/Annots [ 999 0 R ] >> endobj -974 0 obj << +999 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [205.998 645.357 217.953 654.268] /Subtype /Link /A << /S /GoTo /D (table.16) >> >> endobj -983 0 obj << -/D [981 0 R /XYZ 99.895 740.998 null] +1008 0 obj << +/D [1006 0 R /XYZ 99.895 740.998 null] >> endobj -980 0 obj << -/Font << /F27 433 0 R /F8 434 0 R /F11 587 0 R >> +1005 0 obj << +/Font << /F27 441 0 R /F8 442 0 R /F11 597 0 R >> /ProcSet [ /PDF /Text ] >> endobj -986 0 obj << +1011 0 obj << /Length 6529 >> stream @@ -10157,32 +10382,32 @@ BT 0 g 0 G /F8 9.9626 Tf 14.211 0 Td [(Data)-363(allo)-28(cation:)-504(the)-363(set)-364(of)-363(global)-363(indices)]TJ/F11 9.9626 Tf 182.789 0 Td [(v)-36(l)]TJ/F8 9.9626 Tf 8.355 0 Td [(\0501)-328(:)]TJ/F11 9.9626 Tf 18.15 0 Td [(nl)]TJ/F8 9.9626 Tf 9.149 0 Td [(\051)-363(b)-28(elonging)-363(to)-363(the)-364(callin)1(g)]TJ -207.747 -11.955 Td [(pro)-28(cess.)]TJ 0 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 27.95 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf 23.074 0 Td [(.)]TJ -51.024 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 25.183 0 Td [(optional)]TJ/F8 9.9626 Tf 40.577 0 Td [(.)]TJ -65.76 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.485 0 Td [(in)]TJ/F8 9.9626 Tf 9.548 0 Td [(.)]TJ -43.033 -11.956 Td [(Sp)-28(eci\014ed)-333(as:)-445(an)-333(in)28(teger)-333(arra)27(y)84(.)]TJ 0 g 0 G - 141.967 -29.888 Td [(52)]TJ + 141.967 -29.888 Td [(54)]TJ 0 g 0 G ET endstream endobj -985 0 obj << +1010 0 obj << /Type /Page -/Contents 986 0 R -/Resources 984 0 R +/Contents 1011 0 R +/Resources 1009 0 R /MediaBox [0 0 595.276 841.89] -/Parent 972 0 R +/Parent 981 0 R >> endobj -987 0 obj << -/D [985 0 R /XYZ 150.705 740.998 null] +1012 0 obj << +/D [1010 0 R /XYZ 150.705 740.998 null] >> endobj -174 0 obj << -/D [985 0 R /XYZ 150.705 716.092 null] +182 0 obj << +/D [1010 0 R /XYZ 150.705 716.092 null] >> endobj -178 0 obj << -/D [985 0 R /XYZ 150.705 673.557 null] +186 0 obj << +/D [1010 0 R /XYZ 150.705 673.557 null] >> endobj -984 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F8 434 0 R /F27 433 0 R /F11 587 0 R /F14 604 0 R >> +1009 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F8 442 0 R /F27 441 0 R /F11 597 0 R /F14 614 0 R >> /ProcSet [ /PDF /Text ] >> endobj -991 0 obj << +1016 0 obj << /Length 6340 >> stream @@ -10260,37 +10485,37 @@ BT 0 g 0 G /F8 9.9626 Tf 32.191 0 Td [(The)-333(global)-334(index)-333(to)-333(b)-28(e)-333(mapp)-28(ed;)]TJ 0 g 0 G - 62.73 -29.888 Td [(53)]TJ + 62.73 -29.888 Td [(55)]TJ 0 g 0 G ET endstream endobj -990 0 obj << +1015 0 obj << /Type /Page -/Contents 991 0 R -/Resources 989 0 R +/Contents 1016 0 R +/Resources 1014 0 R /MediaBox [0 0 595.276 841.89] -/Parent 972 0 R -/Annots [ 988 0 R ] +/Parent 1019 0 R +/Annots [ 1013 0 R ] >> endobj -988 0 obj << +1013 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [294.721 406.032 361.779 417.157] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -992 0 obj << -/D [990 0 R /XYZ 99.895 740.998 null] +1017 0 obj << +/D [1015 0 R /XYZ 99.895 740.998 null] >> endobj -993 0 obj << -/D [990 0 R /XYZ 99.895 315.593 null] +1018 0 obj << +/D [1015 0 R /XYZ 99.895 315.593 null] >> endobj -989 0 obj << -/Font << /F27 433 0 R /F8 434 0 R /F30 601 0 R /F16 431 0 R >> +1014 0 obj << +/Font << /F27 441 0 R /F8 442 0 R /F30 611 0 R /F16 439 0 R >> /ProcSet [ /PDF /Text ] >> endobj -996 0 obj << +1022 0 obj << /Length 10027 >> stream @@ -10350,41 +10575,41 @@ BT 0 g 0 G [-500(When)-222(the)-222(subroutine)-222(is)-223(in)28(v)28(ok)28(ed)-223(with)]TJ/F30 9.9626 Tf 170.611 0 Td [(vl)]TJ/F8 9.9626 Tf 12.674 0 Td [(in)-222(conjunction)-222(with)]TJ/F30 9.9626 Tf 84.959 0 Td [(globalcheck=.false.)]TJ/F8 9.9626 Tf 99.377 0 Td [(,)]TJ -354.891 -11.955 Td [(no)-405(index)-405(space)-405(scan)-405(will)-405(tak)28(e)-405(place.)-660(Th)28(us)-405(it)-405(is)-405(the)-405(resp)-28(onsibilit)28(y)-405(of)-405(the)]TJ 0 -11.955 Td [(user)-419(to)-418(mak)28(e)-419(sure)-418(that)-419(the)-418(indices)-419(sp)-28(eci\014ed)-418(in)]TJ/F30 9.9626 Tf 211.319 0 Td [(vl)]TJ/F8 9.9626 Tf 14.63 0 Td [(ha)28(v)28(e)-419(neither)-418(orphans)]TJ -225.949 -11.956 Td [(nor)-333(o)27(v)28(erlaps;)-333(if)-333(this)-334(assumption)-333(fails,)-333(results)-334(will)-333(b)-28(e)-333(unpredictable.)]TJ 0 g 0 G - 141.968 -29.887 Td [(54)]TJ + 141.968 -29.887 Td [(56)]TJ 0 g 0 G ET endstream endobj -995 0 obj << +1021 0 obj << /Type /Page -/Contents 996 0 R -/Resources 994 0 R +/Contents 1022 0 R +/Resources 1020 0 R /MediaBox [0 0 595.276 841.89] -/Parent 972 0 R +/Parent 1019 0 R >> endobj -997 0 obj << -/D [995 0 R /XYZ 150.705 740.998 null] +1023 0 obj << +/D [1021 0 R /XYZ 150.705 740.998 null] >> endobj -998 0 obj << -/D [995 0 R /XYZ 150.705 287.871 null] +1024 0 obj << +/D [1021 0 R /XYZ 150.705 287.871 null] >> endobj -999 0 obj << -/D [995 0 R /XYZ 150.705 267.476 null] +1025 0 obj << +/D [1021 0 R /XYZ 150.705 267.476 null] >> endobj -1000 0 obj << -/D [995 0 R /XYZ 150.705 235.127 null] +1026 0 obj << +/D [1021 0 R /XYZ 150.705 235.127 null] >> endobj -1001 0 obj << -/D [995 0 R /XYZ 150.705 214.456 null] +1027 0 obj << +/D [1021 0 R /XYZ 150.705 214.456 null] >> endobj -1002 0 obj << -/D [995 0 R /XYZ 150.705 172.366 null] +1028 0 obj << +/D [1021 0 R /XYZ 150.705 172.366 null] >> endobj -994 0 obj << -/Font << /F27 433 0 R /F8 434 0 R /F30 601 0 R /F14 604 0 R /F11 587 0 R /F10 603 0 R >> +1020 0 obj << +/Font << /F27 441 0 R /F8 442 0 R /F30 611 0 R /F14 614 0 R /F11 597 0 R /F10 613 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1005 0 obj << +1031 0 obj << /Length 507 >> stream @@ -10396,29 +10621,29 @@ BT 0 g 0 G [-500(Orphan)-313(and)-312(o)27(v)28(erlap)-312(indices)-313(are)-313(imp)-28(ossible)-313(b)28(y)-313(construction)-312(when)-313(the)-313(sub-)]TJ 12.73 -11.955 Td [(routine)-333(is)-334(in)28(v)28(ok)28(ed)-334(with)]TJ/F30 9.9626 Tf 103.307 0 Td [(nl)]TJ/F8 9.9626 Tf 13.782 0 Td [(\050alone\051,)-333(or)]TJ/F30 9.9626 Tf 48.734 0 Td [(vg)]TJ/F8 9.9626 Tf 10.46 0 Td [(.)]TJ 0 g 0 G - -34.315 -603.736 Td [(55)]TJ + -34.315 -603.736 Td [(57)]TJ 0 g 0 G ET endstream endobj -1004 0 obj << +1030 0 obj << /Type /Page -/Contents 1005 0 R -/Resources 1003 0 R +/Contents 1031 0 R +/Resources 1029 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1008 0 R +/Parent 1019 0 R >> endobj -1006 0 obj << -/D [1004 0 R /XYZ 99.895 740.998 null] +1032 0 obj << +/D [1030 0 R /XYZ 99.895 740.998 null] >> endobj -1007 0 obj << -/D [1004 0 R /XYZ 99.895 716.092 null] +1033 0 obj << +/D [1030 0 R /XYZ 99.895 716.092 null] >> endobj -1003 0 obj << -/Font << /F8 434 0 R /F30 601 0 R >> +1029 0 obj << +/Font << /F8 442 0 R /F30 611 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1012 0 obj << +1037 0 obj << /Length 5575 >> stream @@ -10500,43 +10725,43 @@ BT 0 g 0 G [-500(This)-305(rout)1(ine)-305(automatically)-305(ign)1(ores)-305(edges)-305(that)-304(do)-305(not)-304(insist)-305(on)-304(the)-305(curren)28(t)]TJ 12.73 -11.955 Td [(pro)-28(cess,)-285(i.e.)-424(edges)-272(for)-273(whic)28(h)-272(neither)-273(the)-272(starting)-272(nor)-273(the)-272(end)-273(v)28(ertex)-272(b)-28(elong)]TJ 0 -11.955 Td [(to)-333(the)-334(curren)28(t)-333(pro)-28(cess.)]TJ 0 g 0 G - 141.968 -51.349 Td [(56)]TJ + 141.968 -51.349 Td [(58)]TJ 0 g 0 G ET endstream endobj -1011 0 obj << +1036 0 obj << /Type /Page -/Contents 1012 0 R -/Resources 1010 0 R +/Contents 1037 0 R +/Resources 1035 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1008 0 R -/Annots [ 1009 0 R ] +/Parent 1019 0 R +/Annots [ 1034 0 R ] >> endobj -1009 0 obj << +1034 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [345.53 292.001 412.588 303.126] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -1013 0 obj << -/D [1011 0 R /XYZ 150.705 740.998 null] +1038 0 obj << +/D [1036 0 R /XYZ 150.705 740.998 null] >> endobj -182 0 obj << -/D [1011 0 R /XYZ 150.705 697.37 null] +190 0 obj << +/D [1036 0 R /XYZ 150.705 697.37 null] >> endobj -1014 0 obj << -/D [1011 0 R /XYZ 150.705 201.563 null] +1039 0 obj << +/D [1036 0 R /XYZ 150.705 201.563 null] >> endobj -1015 0 obj << -/D [1011 0 R /XYZ 150.705 179.7 null] +1040 0 obj << +/D [1036 0 R /XYZ 150.705 179.7 null] >> endobj -1010 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F8 434 0 R /F27 433 0 R /F11 587 0 R >> +1035 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F8 442 0 R /F27 441 0 R /F11 597 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1020 0 obj << +1045 0 obj << /Length 3494 >> stream @@ -10631,47 +10856,47 @@ BT 0 g 0 G [-500(On)-333(exit)-334(from)-333(this)-333(routine)-333(the)-334(descriptor)-333(is)-333(in)-334(the)-333(assem)28(bled)-334(state.)]TJ 0 g 0 G - 154.698 -288.46 Td [(57)]TJ + 154.698 -288.46 Td [(59)]TJ 0 g 0 G ET endstream endobj -1019 0 obj << +1044 0 obj << /Type /Page -/Contents 1020 0 R -/Resources 1018 0 R +/Contents 1045 0 R +/Resources 1043 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1008 0 R -/Annots [ 1016 0 R 1017 0 R ] +/Parent 1019 0 R +/Annots [ 1041 0 R 1042 0 R ] >> endobj -1016 0 obj << +1041 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [294.721 574.94 361.779 586.065] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -1017 0 obj << +1042 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [294.721 485.277 361.779 496.401] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -1021 0 obj << -/D [1019 0 R /XYZ 99.895 740.998 null] +1046 0 obj << +/D [1044 0 R /XYZ 99.895 740.998 null] >> endobj -186 0 obj << -/D [1019 0 R /XYZ 99.895 697.37 null] +194 0 obj << +/D [1044 0 R /XYZ 99.895 697.37 null] >> endobj -1022 0 obj << -/D [1019 0 R /XYZ 99.895 394.838 null] +1047 0 obj << +/D [1044 0 R /XYZ 99.895 394.838 null] >> endobj -1018 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F27 433 0 R /F8 434 0 R >> +1043 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F27 441 0 R /F8 442 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1027 0 obj << +1052 0 obj << /Length 3278 >> stream @@ -10762,44 +10987,44 @@ BT 0 g 0 G /F8 9.9626 Tf 23.758 0 Td [(Error)-333(co)-28(de.)]TJ 1.148 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.612 0 Td [(required)]TJ/F8 9.9626 Tf -29.612 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(out)]TJ/F8 9.9626 Tf 16.549 0 Td [(.)]TJ -50.035 -11.955 Td [(An)-333(in)27(t)1(e)-1(ger)-333(v)56(alue;)-334(0)-333(means)-333(no)-334(error)-333(has)-333(b)-28(een)-333(detec)-1(ted.)]TJ 0 g 0 G - 141.968 -330.303 Td [(58)]TJ + 141.968 -330.303 Td [(60)]TJ 0 g 0 G ET endstream endobj -1026 0 obj << +1051 0 obj << /Type /Page -/Contents 1027 0 R -/Resources 1025 0 R +/Contents 1052 0 R +/Resources 1050 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1008 0 R -/Annots [ 1023 0 R 1024 0 R ] +/Parent 1019 0 R +/Annots [ 1048 0 R 1049 0 R ] >> endobj -1023 0 obj << +1048 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [345.53 574.94 412.588 586.065] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -1024 0 obj << +1049 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [345.53 485.277 412.588 496.401] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -1028 0 obj << -/D [1026 0 R /XYZ 150.705 740.998 null] +1053 0 obj << +/D [1051 0 R /XYZ 150.705 740.998 null] >> endobj -190 0 obj << -/D [1026 0 R /XYZ 150.705 697.37 null] +198 0 obj << +/D [1051 0 R /XYZ 150.705 697.37 null] >> endobj -1025 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F27 433 0 R /F8 434 0 R >> +1050 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F27 441 0 R /F8 442 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1032 0 obj << +1057 0 obj << /Length 2243 >> stream @@ -10861,37 +11086,37 @@ BT 0 g 0 G /F8 9.9626 Tf 23.758 0 Td [(Error)-333(co)-28(de.)]TJ 1.149 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf -29.611 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(out)]TJ/F8 9.9626 Tf 16.549 0 Td [(.)]TJ -50.035 -11.955 Td [(An)-333(in)28(tege)-1(r)-333(v)56(alue;)-334(0)-333(means)-333(no)-334(error)-333(has)-333(b)-28(een)-333(detecte)-1(d)1(.)]TJ 0 g 0 G - 141.968 -398.049 Td [(59)]TJ + 141.968 -398.049 Td [(61)]TJ 0 g 0 G ET endstream endobj -1031 0 obj << +1056 0 obj << /Type /Page -/Contents 1032 0 R -/Resources 1030 0 R +/Contents 1057 0 R +/Resources 1055 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1008 0 R -/Annots [ 1029 0 R ] +/Parent 1059 0 R +/Annots [ 1054 0 R ] >> endobj -1029 0 obj << +1054 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [294.721 574.94 361.779 586.065] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -1033 0 obj << -/D [1031 0 R /XYZ 99.895 740.998 null] +1058 0 obj << +/D [1056 0 R /XYZ 99.895 740.998 null] >> endobj -194 0 obj << -/D [1031 0 R /XYZ 99.895 697.37 null] +202 0 obj << +/D [1056 0 R /XYZ 99.895 697.37 null] >> endobj -1030 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F27 433 0 R /F8 434 0 R >> +1055 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F27 441 0 R /F8 442 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1038 0 obj << +1064 0 obj << /Length 5915 >> stream @@ -10994,44 +11219,44 @@ BT 0 g 0 G /F8 9.9626 Tf 23.758 0 Td [(Error)-333(co)-28(de.)]TJ 1.148 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.612 0 Td [(required)]TJ/F8 9.9626 Tf -29.612 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(out)]TJ/F8 9.9626 Tf 16.549 0 Td [(.)]TJ -50.035 -11.955 Td [(An)-333(in)27(t)1(e)-1(ger)-333(v)56(alue;)-334(0)-333(means)-333(no)-334(error)-333(has)-333(b)-28(een)-333(detec)-1(ted.)]TJ/F16 11.9552 Tf -24.906 -23.476 Td [(Notes)]TJ 0 g 0 G -/F8 9.9626 Tf 166.874 -29.888 Td [(60)]TJ +/F8 9.9626 Tf 166.874 -29.888 Td [(62)]TJ 0 g 0 G ET endstream endobj -1037 0 obj << +1063 0 obj << /Type /Page -/Contents 1038 0 R -/Resources 1036 0 R +/Contents 1064 0 R +/Resources 1062 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1008 0 R -/Annots [ 1034 0 R 1035 0 R ] +/Parent 1059 0 R +/Annots [ 1060 0 R 1061 0 R ] >> endobj -1034 0 obj << +1060 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [345.53 453.24 417.818 464.364] /Subtype /Link /A << /S /GoTo /D (spdata) >> >> endobj -1035 0 obj << +1061 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [345.53 209.896 412.588 221.021] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -1039 0 obj << -/D [1037 0 R /XYZ 150.705 740.998 null] +1065 0 obj << +/D [1063 0 R /XYZ 150.705 740.998 null] >> endobj -198 0 obj << -/D [1037 0 R /XYZ 150.705 685.412 null] +206 0 obj << +/D [1063 0 R /XYZ 150.705 685.412 null] >> endobj -1036 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F8 434 0 R /F27 433 0 R /F11 587 0 R /F14 604 0 R >> +1062 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F8 442 0 R /F27 441 0 R /F11 597 0 R /F14 614 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1042 0 obj << +1068 0 obj << /Length 1591 >> stream @@ -11047,32 +11272,32 @@ BT 0 g 0 G [-500(Sp)-28(ecifying)]TJ/F30 9.9626 Tf 60.957 0 Td [(psb_ovt_asov_)]TJ/F8 9.9626 Tf 71.666 0 Td [(for)-368(the)]TJ/F30 9.9626 Tf 33.107 0 Td [(extype)]TJ/F8 9.9626 Tf 35.054 0 Td [(argumen)28(t)-369(the)-368(user)-369(will)-368(obtain)]TJ -188.054 -11.955 Td [(a)-458(descriptor)-459(with)-458(an)-458(o)28(v)27(erlapp)-27(ed)-459(decomp)-27(os)-1(iti)1(on:)-695(the)-458(additional)-458(la)27(y)28(er)-458(is)]TJ 0 -11.955 Td [(aggregated)-413(to)-413(the)-413(lo)-28(cal)-413(sub)-28(domain)-413(\050and)-413(th)28(us)-414(is)-413(an)-413(o)28(v)28(erlap\051,)-433(and)-413(a)-414(new)]TJ 0 -11.955 Td [(halo)-333(extending)-334(b)-27(ey)27(on)1(d)-334(the)-333(last)-333(additional)-334(la)28(y)28(er)-333(is)-334(formed.)]TJ 0 g 0 G - 141.968 -524.035 Td [(61)]TJ + 141.968 -524.035 Td [(63)]TJ 0 g 0 G ET endstream endobj -1041 0 obj << +1067 0 obj << /Type /Page -/Contents 1042 0 R -/Resources 1040 0 R +/Contents 1068 0 R +/Resources 1066 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1046 0 R +/Parent 1059 0 R >> endobj -1043 0 obj << -/D [1041 0 R /XYZ 99.895 740.998 null] +1069 0 obj << +/D [1067 0 R /XYZ 99.895 740.998 null] >> endobj -1044 0 obj << -/D [1041 0 R /XYZ 99.895 716.092 null] +1070 0 obj << +/D [1067 0 R /XYZ 99.895 716.092 null] >> endobj -1045 0 obj << -/D [1041 0 R /XYZ 99.895 664.341 null] +1071 0 obj << +/D [1067 0 R /XYZ 99.895 664.341 null] >> endobj -1040 0 obj << -/Font << /F8 434 0 R /F30 601 0 R >> +1066 0 obj << +/Font << /F8 442 0 R /F30 611 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1051 0 obj << +1076 0 obj << /Length 4886 >> stream @@ -11172,53 +11397,53 @@ BT 0 g 0 G [-500(Pro)28(viding)-307(a)-308(go)-27(o)-28(d)-307(e)-1(stimate)-307(for)-307(the)-307(n)27(um)28(b)-28(er)-307(of)-307(nonzero)-28(es)]TJ/F11 9.9626 Tf 254.288 0 Td [(nnz)]TJ/F8 9.9626 Tf 20.093 0 Td [(in)-307(the)-308(assem-)]TJ -261.651 -11.955 Td [(bled)-402(matrix)-401(ma)28(y)-402(substan)28(tially)-401(impro)27(v)28(e)-401(p)-28(erformance)-402(in)-401(the)-402(matrix)-401(build)]TJ 0 -11.955 Td [(phase,)-458(as)-433(it)-432(will)-433(reduce)-433(or)-433(eliminate)-433(the)-433(need)-432(for)-433(\050p)-28(oten)28(tially)-433(m)28(ultiple\051)]TJ 0 -11.956 Td [(data)-333(reallo)-28(cations.)]TJ 0 g 0 G - 141.968 -133.042 Td [(62)]TJ + 141.968 -133.042 Td [(64)]TJ 0 g 0 G ET endstream endobj -1050 0 obj << +1075 0 obj << /Type /Page -/Contents 1051 0 R -/Resources 1049 0 R +/Contents 1076 0 R +/Resources 1074 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1046 0 R -/Annots [ 1047 0 R 1048 0 R ] +/Parent 1059 0 R +/Annots [ 1072 0 R 1073 0 R ] >> endobj -1047 0 obj << +1072 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [345.53 574.94 412.588 586.065] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -1048 0 obj << +1073 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [345.53 405.575 417.818 416.7] /Subtype /Link /A << /S /GoTo /D (spdata) >> >> endobj -1052 0 obj << -/D [1050 0 R /XYZ 150.705 740.998 null] +1077 0 obj << +/D [1075 0 R /XYZ 150.705 740.998 null] >> endobj -202 0 obj << -/D [1050 0 R /XYZ 150.705 697.37 null] +210 0 obj << +/D [1075 0 R /XYZ 150.705 697.37 null] >> endobj -1053 0 obj << -/D [1050 0 R /XYZ 150.705 315.137 null] +1078 0 obj << +/D [1075 0 R /XYZ 150.705 315.137 null] >> endobj -1054 0 obj << -/D [1050 0 R /XYZ 150.705 293.274 null] +1079 0 obj << +/D [1075 0 R /XYZ 150.705 293.274 null] >> endobj -1055 0 obj << -/D [1050 0 R /XYZ 150.705 273.349 null] +1080 0 obj << +/D [1075 0 R /XYZ 150.705 273.349 null] >> endobj -1049 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F27 433 0 R /F8 434 0 R /F11 587 0 R >> +1074 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F27 441 0 R /F8 442 0 R /F11 597 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1061 0 obj << +1086 0 obj << /Length 6672 >> stream @@ -11343,51 +11568,51 @@ BT 0 g 0 G /F8 9.9626 Tf 20.922 0 Td [(.)]TJ 0 g 0 G - -60.444 -41.843 Td [(63)]TJ + -60.444 -41.843 Td [(65)]TJ 0 g 0 G ET endstream endobj -1060 0 obj << +1085 0 obj << /Type /Page -/Contents 1061 0 R -/Resources 1059 0 R +/Contents 1086 0 R +/Resources 1084 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1046 0 R -/Annots [ 1056 0 R 1057 0 R 1058 0 R ] +/Parent 1059 0 R +/Annots [ 1081 0 R 1082 0 R 1083 0 R ] >> endobj -1056 0 obj << +1081 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [261.152 296.208 328.21 307.333] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -1057 0 obj << +1082 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [294.721 196.322 367.009 207.447] /Subtype /Link /A << /S /GoTo /D (spdata) >> >> endobj -1058 0 obj << +1083 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [261.152 129.071 328.21 140.196] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -1062 0 obj << -/D [1060 0 R /XYZ 99.895 740.998 null] +1087 0 obj << +/D [1085 0 R /XYZ 99.895 740.998 null] >> endobj -206 0 obj << -/D [1060 0 R /XYZ 99.895 697.37 null] +214 0 obj << +/D [1085 0 R /XYZ 99.895 697.37 null] >> endobj -1059 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F27 433 0 R /F8 434 0 R /F11 587 0 R >> +1084 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F27 441 0 R /F8 442 0 R /F11 597 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1065 0 obj << +1090 0 obj << /Length 3014 >> stream @@ -11423,44 +11648,44 @@ BT 0 g 0 G [-500(If)-309(the)-308(matrix)-309(is)-308(in)-309(the)-308(up)-28(date)-309(state,)-313(an)28(y)-309(en)28(tries)-309(in)-308(p)-28(ositions)-309(that)-308(w)28(ere)-309(not)]TJ 12.73 -11.955 Td [(presen)28(t)-334(in)-333(the)-333(original)-333(matrix)-334(will)-333(b)-28(e)-333(ignored.)]TJ 0 g 0 G - 141.968 -306.849 Td [(64)]TJ + 141.968 -306.849 Td [(66)]TJ 0 g 0 G ET endstream endobj -1064 0 obj << +1089 0 obj << /Type /Page -/Contents 1065 0 R -/Resources 1063 0 R +/Contents 1090 0 R +/Resources 1088 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1046 0 R +/Parent 1059 0 R >> endobj -1066 0 obj << -/D [1064 0 R /XYZ 150.705 740.998 null] +1091 0 obj << +/D [1089 0 R /XYZ 150.705 740.998 null] >> endobj -1067 0 obj << -/D [1064 0 R /XYZ 150.705 632.405 null] +1092 0 obj << +/D [1089 0 R /XYZ 150.705 632.405 null] >> endobj -1068 0 obj << -/D [1064 0 R /XYZ 150.705 600.525 null] +1093 0 obj << +/D [1089 0 R /XYZ 150.705 600.525 null] >> endobj -1069 0 obj << -/D [1064 0 R /XYZ 150.705 566.707 null] +1094 0 obj << +/D [1089 0 R /XYZ 150.705 566.707 null] >> endobj -1070 0 obj << -/D [1064 0 R /XYZ 150.705 498.961 null] +1095 0 obj << +/D [1089 0 R /XYZ 150.705 498.961 null] >> endobj -1071 0 obj << -/D [1064 0 R /XYZ 150.705 467.081 null] +1096 0 obj << +/D [1089 0 R /XYZ 150.705 467.081 null] >> endobj -1072 0 obj << -/D [1064 0 R /XYZ 150.705 423.245 null] +1097 0 obj << +/D [1089 0 R /XYZ 150.705 423.245 null] >> endobj -1063 0 obj << -/Font << /F27 433 0 R /F8 434 0 R /F16 431 0 R /F30 601 0 R >> +1088 0 obj << +/Font << /F27 441 0 R /F8 442 0 R /F16 439 0 R /F30 611 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1077 0 obj << +1102 0 obj << /Length 5985 >> stream @@ -11564,50 +11789,50 @@ BT 0 g 0 G [-500(The)-333(sparse)-334(matrix)-333(ma)28(y)-334(b)-27(e)-334(in)-333(either)-333(the)-334(build)-333(or)-333(up)-28(date)-333(state;)]TJ 0 g 0 G - 154.698 -29.888 Td [(65)]TJ + 154.698 -29.888 Td [(67)]TJ 0 g 0 G ET endstream endobj -1076 0 obj << +1101 0 obj << /Type /Page -/Contents 1077 0 R -/Resources 1075 0 R +/Contents 1102 0 R +/Resources 1100 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1046 0 R -/Annots [ 1073 0 R 1074 0 R ] +/Parent 1106 0 R +/Annots [ 1098 0 R 1099 0 R ] >> endobj -1073 0 obj << +1098 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [294.721 571.784 361.779 582.909] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -1074 0 obj << +1099 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [294.721 262.266 367.009 273.391] /Subtype /Link /A << /S /GoTo /D (spdata) >> >> endobj -1078 0 obj << -/D [1076 0 R /XYZ 99.895 740.998 null] +1103 0 obj << +/D [1101 0 R /XYZ 99.895 740.998 null] >> endobj -210 0 obj << -/D [1076 0 R /XYZ 99.895 697.159 null] +218 0 obj << +/D [1101 0 R /XYZ 99.895 697.159 null] >> endobj -1079 0 obj << -/D [1076 0 R /XYZ 99.895 169.619 null] +1104 0 obj << +/D [1101 0 R /XYZ 99.895 169.619 null] >> endobj -1080 0 obj << -/D [1076 0 R /XYZ 99.895 134.543 null] +1105 0 obj << +/D [1101 0 R /XYZ 99.895 134.543 null] >> endobj -1075 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F27 433 0 R /F8 434 0 R >> +1100 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F27 441 0 R /F8 442 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1083 0 obj << +1109 0 obj << /Length 1520 >> stream @@ -11627,35 +11852,35 @@ BT 0 g 0 G [-500(On)-370(exit)-370(from)-370(this)-370(routine)-370(the)-370(matrix)-370(is)-370(in)-370(the)-370(assem)28(bled)-370(state,)-380(an)1(d)-370(th)27(us)]TJ 12.73 -11.956 Td [(is)-333(suitable)-334(for)-333(the)-333(computational)-334(rou)1(tines)-1(.)]TJ 0 g 0 G - 141.968 -516.064 Td [(66)]TJ + 141.968 -516.064 Td [(68)]TJ 0 g 0 G ET endstream endobj -1082 0 obj << +1108 0 obj << /Type /Page -/Contents 1083 0 R -/Resources 1081 0 R +/Contents 1109 0 R +/Resources 1107 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1046 0 R +/Parent 1106 0 R >> endobj -1084 0 obj << -/D [1082 0 R /XYZ 150.705 740.998 null] +1110 0 obj << +/D [1108 0 R /XYZ 150.705 740.998 null] >> endobj -1085 0 obj << -/D [1082 0 R /XYZ 150.705 716.092 null] +1111 0 obj << +/D [1108 0 R /XYZ 150.705 716.092 null] >> endobj -1086 0 obj << -/D [1082 0 R /XYZ 150.705 676.296 null] +1112 0 obj << +/D [1108 0 R /XYZ 150.705 676.296 null] >> endobj -1087 0 obj << -/D [1082 0 R /XYZ 150.705 632.461 null] +1113 0 obj << +/D [1108 0 R /XYZ 150.705 632.461 null] >> endobj -1081 0 obj << -/Font << /F8 434 0 R /F30 601 0 R >> +1107 0 obj << +/Font << /F8 442 0 R /F30 611 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1092 0 obj << +1118 0 obj << /Length 3085 >> stream @@ -11739,44 +11964,44 @@ BT 0 g 0 G /F8 9.9626 Tf 23.758 0 Td [(Error)-333(co)-28(de.)]TJ 1.149 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf -29.611 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(out)]TJ/F8 9.9626 Tf 16.549 0 Td [(.)]TJ -50.035 -11.955 Td [(An)-333(in)28(tege)-1(r)-333(v)56(alue;)-334(0)-333(means)-333(no)-334(error)-333(has)-333(b)-28(een)-333(detecte)-1(d)1(.)]TJ 0 g 0 G - 141.968 -330.303 Td [(67)]TJ + 141.968 -330.303 Td [(69)]TJ 0 g 0 G ET endstream endobj -1091 0 obj << +1117 0 obj << /Type /Page -/Contents 1092 0 R -/Resources 1090 0 R +/Contents 1118 0 R +/Resources 1116 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1094 0 R -/Annots [ 1088 0 R 1089 0 R ] +/Parent 1106 0 R +/Annots [ 1114 0 R 1115 0 R ] >> endobj -1088 0 obj << +1114 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [294.721 574.94 367.009 586.065] /Subtype /Link /A << /S /GoTo /D (spdata) >> >> endobj -1089 0 obj << +1115 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [294.721 507.194 361.779 518.319] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -1093 0 obj << -/D [1091 0 R /XYZ 99.895 740.998 null] +1119 0 obj << +/D [1117 0 R /XYZ 99.895 740.998 null] >> endobj -214 0 obj << -/D [1091 0 R /XYZ 99.895 697.37 null] +222 0 obj << +/D [1117 0 R /XYZ 99.895 697.37 null] >> endobj -1090 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F27 433 0 R /F8 434 0 R >> +1116 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F27 441 0 R /F8 442 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1099 0 obj << +1124 0 obj << /Length 3975 >> stream @@ -11868,47 +12093,47 @@ BT 0 g 0 G [-500(On)-333(exit)-334(from)-333(this)-333(routine)-334(t)1(he)-334(sparse)-333(matrix)-334(is)-333(in)-333(the)-333(up)-28(date)-334(state.)]TJ 0 g 0 G - 154.698 -206.766 Td [(68)]TJ + 154.698 -206.766 Td [(70)]TJ 0 g 0 G ET endstream endobj -1098 0 obj << +1123 0 obj << /Type /Page -/Contents 1099 0 R -/Resources 1097 0 R +/Contents 1124 0 R +/Resources 1122 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1094 0 R -/Annots [ 1095 0 R 1096 0 R ] +/Parent 1106 0 R +/Annots [ 1120 0 R 1121 0 R ] >> endobj -1095 0 obj << +1120 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [345.53 560.993 417.818 572.118] /Subtype /Link /A << /S /GoTo /D (spdata) >> >> endobj -1096 0 obj << +1121 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [345.53 493.247 412.588 504.372] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -1100 0 obj << -/D [1098 0 R /XYZ 150.705 740.998 null] +1125 0 obj << +/D [1123 0 R /XYZ 150.705 740.998 null] >> endobj -218 0 obj << -/D [1098 0 R /XYZ 150.705 685.747 null] +226 0 obj << +/D [1123 0 R /XYZ 150.705 685.747 null] >> endobj -1101 0 obj << -/D [1098 0 R /XYZ 150.705 313.144 null] +1126 0 obj << +/D [1123 0 R /XYZ 150.705 313.144 null] >> endobj -1097 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F27 433 0 R /F8 434 0 R >> +1122 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F27 441 0 R /F8 442 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1105 0 obj << +1130 0 obj << /Length 4603 >> stream @@ -11982,37 +12207,37 @@ BT 0 g 0 G /F8 9.9626 Tf 23.758 0 Td [(Error)-333(co)-28(de.)]TJ 1.149 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf -29.611 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(out)]TJ/F8 9.9626 Tf 16.549 0 Td [(.)]TJ -50.035 -11.955 Td [(An)-333(in)28(tege)-1(r)-333(v)56(alue;)-334(0)-333(means)-333(no)-334(error)-333(has)-333(b)-28(een)-333(detecte)-1(d)1(.)]TJ 0 g 0 G - 141.968 -123.08 Td [(69)]TJ + 141.968 -123.08 Td [(71)]TJ 0 g 0 G ET endstream endobj -1104 0 obj << +1129 0 obj << /Type /Page -/Contents 1105 0 R -/Resources 1103 0 R +/Contents 1130 0 R +/Resources 1128 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1094 0 R -/Annots [ 1102 0 R ] +/Parent 1106 0 R +/Annots [ 1127 0 R ] >> endobj -1102 0 obj << +1127 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [261.152 574.94 328.21 586.065] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -1106 0 obj << -/D [1104 0 R /XYZ 99.895 740.998 null] +1131 0 obj << +/D [1129 0 R /XYZ 99.895 740.998 null] >> endobj -222 0 obj << -/D [1104 0 R /XYZ 99.895 697.37 null] +230 0 obj << +/D [1129 0 R /XYZ 99.895 697.37 null] >> endobj -1103 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F27 433 0 R /F8 434 0 R /F11 587 0 R >> +1128 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F27 441 0 R /F8 442 0 R /F11 597 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1110 0 obj << +1135 0 obj << /Length 6176 >> stream @@ -12094,37 +12319,37 @@ BT 0 g 0 G /F8 9.9626 Tf 23.758 0 Td [(Error)-333(co)-28(de.)]TJ 1.149 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.378 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.378 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf -29.611 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.485 0 Td [(out)]TJ/F8 9.9626 Tf 16.549 0 Td [(.)]TJ -50.034 -11.955 Td [(An)-333(in)28(teger)-334(v)56(alue;)-334(0)-333(means)-333(no)-334(error)-333(has)-333(b)-28(een)-333(detected.)]TJ 0 g 0 G - 141.967 -29.888 Td [(70)]TJ + 141.967 -29.888 Td [(72)]TJ 0 g 0 G ET endstream endobj -1109 0 obj << +1134 0 obj << /Type /Page -/Contents 1110 0 R -/Resources 1108 0 R +/Contents 1135 0 R +/Resources 1133 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1094 0 R -/Annots [ 1107 0 R ] +/Parent 1106 0 R +/Annots [ 1132 0 R ] >> endobj -1107 0 obj << +1132 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [345.53 363.459 412.588 374.584] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -1111 0 obj << -/D [1109 0 R /XYZ 150.705 740.998 null] +1136 0 obj << +/D [1134 0 R /XYZ 150.705 740.998 null] >> endobj -226 0 obj << -/D [1109 0 R /XYZ 150.705 697.37 null] +234 0 obj << +/D [1134 0 R /XYZ 150.705 697.37 null] >> endobj -1108 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F27 433 0 R /F8 434 0 R /F11 587 0 R >> +1133 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F27 441 0 R /F8 442 0 R /F11 597 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1114 0 obj << +1139 0 obj << /Length 554 >> stream @@ -12141,32 +12366,32 @@ BT 0 g 0 G [-500(Duplicate)-292(en)28(tries)-293(are)-292(either)-292(o)28(v)28(erwritten)-292(or)-293(added,)-300(there)-292(is)-292(no)-292(pro)27(vision)-292(for)]TJ 12.73 -11.955 Td [(raising)-333(an)-334(error)-333(condition.)]TJ 0 g 0 G - 141.968 -563.885 Td [(71)]TJ + 141.968 -563.885 Td [(73)]TJ 0 g 0 G ET endstream endobj -1113 0 obj << +1138 0 obj << /Type /Page -/Contents 1114 0 R -/Resources 1112 0 R +/Contents 1139 0 R +/Resources 1137 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1094 0 R +/Parent 1143 0 R >> endobj -1115 0 obj << -/D [1113 0 R /XYZ 99.895 740.998 null] +1140 0 obj << +/D [1138 0 R /XYZ 99.895 740.998 null] >> endobj -1116 0 obj << -/D [1113 0 R /XYZ 99.895 702.144 null] +1141 0 obj << +/D [1138 0 R /XYZ 99.895 702.144 null] >> endobj -1117 0 obj << -/D [1113 0 R /XYZ 99.895 679.728 null] +1142 0 obj << +/D [1138 0 R /XYZ 99.895 679.728 null] >> endobj -1112 0 obj << -/Font << /F16 431 0 R /F8 434 0 R >> +1137 0 obj << +/Font << /F16 439 0 R /F8 442 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1121 0 obj << +1147 0 obj << /Length 2877 >> stream @@ -12232,37 +12457,37 @@ BT 0 g 0 G /F8 9.9626 Tf 23.758 0 Td [(Error)-333(co)-28(de.)]TJ 1.148 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.612 0 Td [(required)]TJ/F8 9.9626 Tf -29.612 -11.956 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(out)]TJ/F8 9.9626 Tf 16.549 0 Td [(.)]TJ -50.035 -11.955 Td [(An)-333(in)28(te)-1(ger)-333(v)56(alue;)-334(0)-333(means)-333(no)-334(error)-333(has)-333(b)-28(een)-333(detec)-1(ted.)]TJ 0 g 0 G - 141.968 -294.437 Td [(72)]TJ + 141.968 -294.437 Td [(74)]TJ 0 g 0 G ET endstream endobj -1120 0 obj << +1146 0 obj << /Type /Page -/Contents 1121 0 R -/Resources 1119 0 R +/Contents 1147 0 R +/Resources 1145 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1094 0 R -/Annots [ 1118 0 R ] +/Parent 1143 0 R +/Annots [ 1144 0 R ] >> endobj -1118 0 obj << +1144 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [311.962 574.94 379.019 586.065] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -1122 0 obj << -/D [1120 0 R /XYZ 150.705 740.998 null] +1148 0 obj << +/D [1146 0 R /XYZ 150.705 740.998 null] >> endobj -230 0 obj << -/D [1120 0 R /XYZ 150.705 697.37 null] +238 0 obj << +/D [1146 0 R /XYZ 150.705 697.37 null] >> endobj -1119 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F27 433 0 R /F8 434 0 R >> +1145 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F27 441 0 R /F8 442 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1126 0 obj << +1152 0 obj << /Length 2881 >> stream @@ -12328,37 +12553,37 @@ BT 0 g 0 G /F8 9.9626 Tf 23.758 0 Td [(Error)-333(co)-28(de.)]TJ 1.149 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf -29.611 -11.956 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(out)]TJ/F8 9.9626 Tf 16.549 0 Td [(.)]TJ -50.035 -11.955 Td [(An)-333(in)28(tege)-1(r)-333(v)56(alue;)-334(0)-333(means)-333(no)-334(error)-333(has)-333(b)-28(een)-333(detecte)-1(d)1(.)]TJ 0 g 0 G - 141.968 -294.437 Td [(73)]TJ + 141.968 -294.437 Td [(75)]TJ 0 g 0 G ET endstream endobj -1125 0 obj << +1151 0 obj << /Type /Page -/Contents 1126 0 R -/Resources 1124 0 R +/Contents 1152 0 R +/Resources 1150 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1128 0 R -/Annots [ 1123 0 R ] +/Parent 1143 0 R +/Annots [ 1149 0 R ] >> endobj -1123 0 obj << +1149 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [261.152 483.284 328.21 494.409] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -1127 0 obj << -/D [1125 0 R /XYZ 99.895 740.998 null] +1153 0 obj << +/D [1151 0 R /XYZ 99.895 740.998 null] >> endobj -234 0 obj << -/D [1125 0 R /XYZ 99.895 697.37 null] +242 0 obj << +/D [1151 0 R /XYZ 99.895 697.37 null] >> endobj -1124 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F27 433 0 R /F8 434 0 R >> +1150 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F27 441 0 R /F8 442 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1131 0 obj << +1156 0 obj << /Length 3438 >> stream @@ -12403,29 +12628,29 @@ BT 0 g 0 G /F8 9.9626 Tf 23.758 0 Td [(Error)-333(co)-28(de.)]TJ 1.149 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.378 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.378 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf -29.611 -11.956 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.485 0 Td [(out)]TJ/F8 9.9626 Tf 16.549 0 Td [(.)]TJ -50.034 -11.955 Td [(An)-333(in)28(tege)-1(r)-333(v)56(alue;)-334(0)-333(means)-333(no)-334(error)-333(has)-333(b)-28(een)-333(detected.)]TJ 0 g 0 G - 141.967 -226.691 Td [(74)]TJ + 141.967 -226.691 Td [(76)]TJ 0 g 0 G ET endstream endobj -1130 0 obj << +1155 0 obj << /Type /Page -/Contents 1131 0 R -/Resources 1129 0 R +/Contents 1156 0 R +/Resources 1154 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1128 0 R +/Parent 1143 0 R >> endobj -1132 0 obj << -/D [1130 0 R /XYZ 150.705 740.998 null] +1157 0 obj << +/D [1155 0 R /XYZ 150.705 740.998 null] >> endobj -238 0 obj << -/D [1130 0 R /XYZ 150.705 697.37 null] +246 0 obj << +/D [1155 0 R /XYZ 150.705 697.37 null] >> endobj -1129 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F27 433 0 R /F8 434 0 R /F11 587 0 R /F10 603 0 R >> +1154 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F27 441 0 R /F8 442 0 R /F11 597 0 R /F10 613 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1136 0 obj << +1161 0 obj << /Length 6540 >> stream @@ -12521,37 +12746,37 @@ BT 0 g 0 G /F8 9.9626 Tf 23.758 0 Td [(Error)-333(co)-28(de.)]TJ 1.149 -11.956 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf -29.611 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(out)]TJ/F8 9.9626 Tf 16.549 0 Td [(.)]TJ -50.035 -11.955 Td [(An)-333(in)28(tege)-1(r)-333(v)56(alue;)-334(0)-333(means)-333(no)-334(error)-333(has)-333(b)-28(een)-333(detecte)-1(d)1(.)]TJ/F16 11.9552 Tf -24.907 -21.202 Td [(Notes)]TJ 0 g 0 G -/F8 9.9626 Tf 166.875 -29.887 Td [(75)]TJ +/F8 9.9626 Tf 166.875 -29.887 Td [(77)]TJ 0 g 0 G ET endstream endobj -1135 0 obj << +1160 0 obj << /Type /Page -/Contents 1136 0 R -/Resources 1134 0 R +/Contents 1161 0 R +/Resources 1159 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1128 0 R -/Annots [ 1133 0 R ] +/Parent 1143 0 R +/Annots [ 1158 0 R ] >> endobj -1133 0 obj << +1158 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [294.721 484.86 361.779 495.985] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -1137 0 obj << -/D [1135 0 R /XYZ 99.895 740.998 null] +1162 0 obj << +/D [1160 0 R /XYZ 99.895 740.998 null] >> endobj -242 0 obj << -/D [1135 0 R /XYZ 99.895 697.37 null] +250 0 obj << +/D [1160 0 R /XYZ 99.895 697.37 null] >> endobj -1134 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F27 433 0 R /F8 434 0 R /F11 587 0 R >> +1159 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F27 441 0 R /F8 442 0 R /F11 597 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1140 0 obj << +1165 0 obj << /Length 705 >> stream @@ -12567,32 +12792,32 @@ BT 0 g 0 G [-500(The)-476(default)]TJ/F30 9.9626 Tf 69.543 0 Td [(I)]TJ/F8 9.9626 Tf 5.23 0 Td [(gnore)-476(means)-477(that)-476(the)-476(negativ)28(e)-477(out)1(put)-477(is)-476(the)-476(only)-476(action)]TJ -62.043 -11.955 Td [(tak)28(en)-334(on)-333(an)-333(out-of-range)-333(input.)]TJ 0 g 0 G - 141.968 -571.855 Td [(76)]TJ + 141.968 -571.855 Td [(78)]TJ 0 g 0 G ET endstream endobj -1139 0 obj << +1164 0 obj << /Type /Page -/Contents 1140 0 R -/Resources 1138 0 R +/Contents 1165 0 R +/Resources 1163 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1128 0 R +/Parent 1143 0 R >> endobj -1141 0 obj << -/D [1139 0 R /XYZ 150.705 740.998 null] +1166 0 obj << +/D [1164 0 R /XYZ 150.705 740.998 null] >> endobj -1142 0 obj << -/D [1139 0 R /XYZ 150.705 716.092 null] +1167 0 obj << +/D [1164 0 R /XYZ 150.705 716.092 null] >> endobj -1143 0 obj << -/D [1139 0 R /XYZ 150.705 688.251 null] +1168 0 obj << +/D [1164 0 R /XYZ 150.705 688.251 null] >> endobj -1138 0 obj << -/Font << /F8 434 0 R /F30 601 0 R >> +1163 0 obj << +/Font << /F8 442 0 R /F30 611 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1147 0 obj << +1172 0 obj << /Length 5721 >> stream @@ -12684,37 +12909,37 @@ BT 0 g 0 G /F8 9.9626 Tf 23.758 0 Td [(Error)-333(co)-28(de.)]TJ 1.149 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf -29.611 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(out)]TJ/F8 9.9626 Tf 16.549 0 Td [(.)]TJ -50.035 -11.955 Td [(An)-333(in)28(tege)-1(r)-333(v)56(alue;)-334(0)-333(means)-333(no)-334(error)-333(has)-333(b)-28(een)-333(detecte)-1(d)1(.)]TJ 0 g 0 G - 141.968 -115.11 Td [(77)]TJ + 141.968 -115.11 Td [(79)]TJ 0 g 0 G ET endstream endobj -1146 0 obj << +1171 0 obj << /Type /Page -/Contents 1147 0 R -/Resources 1145 0 R +/Contents 1172 0 R +/Resources 1170 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1128 0 R -/Annots [ 1144 0 R ] +/Parent 1174 0 R +/Annots [ 1169 0 R ] >> endobj -1144 0 obj << +1169 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [294.721 483.284 361.779 494.409] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -1148 0 obj << -/D [1146 0 R /XYZ 99.895 740.998 null] +1173 0 obj << +/D [1171 0 R /XYZ 99.895 740.998 null] >> endobj -246 0 obj << -/D [1146 0 R /XYZ 99.895 697.37 null] +254 0 obj << +/D [1171 0 R /XYZ 99.895 697.37 null] >> endobj -1145 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F27 433 0 R /F8 434 0 R /F11 587 0 R >> +1170 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F27 441 0 R /F8 442 0 R /F11 597 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1152 0 obj << +1178 0 obj << /Length 3272 >> stream @@ -12791,40 +13016,40 @@ BT 0 g 0 G [-500(This)-300(routine)-300(r)1(e)-1(tu)1(rns)-300(a)]TJ/F30 9.9626 Tf 111.214 0 Td [(.true.)]TJ/F8 9.9626 Tf 34.368 0 Td [(v)56(alue)-300(for)-300(an)-300(index)-299(that)-300(is)-300(strictly)-300(o)28(wned)-300(b)28(y)]TJ -132.852 -11.955 Td [(the)-333(curren)27(t)-333(pro)-28(cess,)-333(excluding)-333(the)-334(halo)-333(indices)]TJ 0 g 0 G - 141.968 -264.549 Td [(78)]TJ + 141.968 -264.549 Td [(80)]TJ 0 g 0 G ET endstream endobj -1151 0 obj << +1177 0 obj << /Type /Page -/Contents 1152 0 R -/Resources 1150 0 R +/Contents 1178 0 R +/Resources 1176 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1128 0 R -/Annots [ 1149 0 R ] +/Parent 1174 0 R +/Annots [ 1175 0 R ] >> endobj -1149 0 obj << +1175 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [345.53 495.239 412.588 506.364] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -1153 0 obj << -/D [1151 0 R /XYZ 150.705 740.998 null] +1179 0 obj << +/D [1177 0 R /XYZ 150.705 740.998 null] >> endobj -250 0 obj << -/D [1151 0 R /XYZ 150.705 697.37 null] +258 0 obj << +/D [1177 0 R /XYZ 150.705 697.37 null] >> endobj -1154 0 obj << -/D [1151 0 R /XYZ 150.705 382.883 null] +1180 0 obj << +/D [1177 0 R /XYZ 150.705 382.883 null] >> endobj -1150 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F27 433 0 R /F8 434 0 R /F11 587 0 R >> +1176 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F27 441 0 R /F8 442 0 R /F11 597 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1158 0 obj << +1184 0 obj << /Length 4972 >> stream @@ -12909,40 +13134,40 @@ BT 0 g 0 G [-500(This)-475(routine)-474(returns)-475(a)]TJ/F30 9.9626 Tf 118.186 0 Td [(.true.)]TJ/F8 9.9626 Tf 36.111 0 Td [(v)56(alue)-475(for)-475(those)-475(indices)-474(that)-475(are)-475(strictly)]TJ -141.567 -11.955 Td [(o)28(wned)-334(b)28(y)-333(the)-333(curren)27(t)-333(pro)-28(cess,)-333(excluding)-333(the)-334(halo)-333(indices)]TJ 0 g 0 G - 141.968 -141.013 Td [(79)]TJ + 141.968 -141.013 Td [(81)]TJ 0 g 0 G ET endstream endobj -1157 0 obj << +1183 0 obj << /Type /Page -/Contents 1158 0 R -/Resources 1156 0 R +/Contents 1184 0 R +/Resources 1182 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1161 0 R -/Annots [ 1155 0 R ] +/Parent 1174 0 R +/Annots [ 1181 0 R ] >> endobj -1155 0 obj << +1181 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [294.721 495.239 361.779 506.364] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -1159 0 obj << -/D [1157 0 R /XYZ 99.895 740.998 null] +1185 0 obj << +/D [1183 0 R /XYZ 99.895 740.998 null] >> endobj -254 0 obj << -/D [1157 0 R /XYZ 99.895 697.37 null] +262 0 obj << +/D [1183 0 R /XYZ 99.895 697.37 null] >> endobj -1160 0 obj << -/D [1157 0 R /XYZ 99.895 259.346 null] +1186 0 obj << +/D [1183 0 R /XYZ 99.895 259.346 null] >> endobj -1156 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F27 433 0 R /F8 434 0 R /F11 587 0 R >> +1182 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F27 441 0 R /F8 442 0 R /F11 597 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1165 0 obj << +1190 0 obj << /Length 3240 >> stream @@ -13019,40 +13244,40 @@ BT 0 g 0 G [-500(This)-239(routine)-239(returns)-239(a)]TJ/F30 9.9626 Tf 108.787 0 Td [(.true.)]TJ/F8 9.9626 Tf 33.762 0 Td [(v)56(alue)-239(for)-239(an)-239(index)-239(that)-239(is)-239(lo)-27(cal)-239(to)-239(the)-239(curren)28(t)]TJ -129.819 -11.955 Td [(pro)-28(cess,)-333(including)-333(the)-334(halo)-333(indices)]TJ 0 g 0 G - 141.968 -264.549 Td [(80)]TJ + 141.968 -264.549 Td [(82)]TJ 0 g 0 G ET endstream endobj -1164 0 obj << +1189 0 obj << /Type /Page -/Contents 1165 0 R -/Resources 1163 0 R +/Contents 1190 0 R +/Resources 1188 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1161 0 R -/Annots [ 1162 0 R ] +/Parent 1174 0 R +/Annots [ 1187 0 R ] >> endobj -1162 0 obj << +1187 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [345.53 495.239 412.588 506.364] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -1166 0 obj << -/D [1164 0 R /XYZ 150.705 740.998 null] +1191 0 obj << +/D [1189 0 R /XYZ 150.705 740.998 null] >> endobj -258 0 obj << -/D [1164 0 R /XYZ 150.705 697.37 null] +266 0 obj << +/D [1189 0 R /XYZ 150.705 697.37 null] >> endobj -1167 0 obj << -/D [1164 0 R /XYZ 150.705 382.883 null] +1192 0 obj << +/D [1189 0 R /XYZ 150.705 382.883 null] >> endobj -1163 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F27 433 0 R /F8 434 0 R /F11 587 0 R >> +1188 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F27 441 0 R /F8 442 0 R /F11 597 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1171 0 obj << +1196 0 obj << /Length 4956 >> stream @@ -13137,40 +13362,40 @@ BT 0 g 0 G [-500(This)-308(routine)-309(retur)1(ns)-309(a)]TJ/F30 9.9626 Tf 111.554 0 Td [(.true.)]TJ/F8 9.9626 Tf 34.454 0 Td [(v)56(alue)-309(for)-308(those)-308(indices)-309(that)-308(are)-308(lo)-28(cal)-308(to)-309(the)]TJ -133.278 -11.955 Td [(curren)28(t)-333(pro)-28(cess,)-334(including)-333(the)-333(halo)-333(indices.)]TJ 0 g 0 G - 141.968 -141.013 Td [(81)]TJ + 141.968 -141.013 Td [(83)]TJ 0 g 0 G ET endstream endobj -1170 0 obj << +1195 0 obj << /Type /Page -/Contents 1171 0 R -/Resources 1169 0 R +/Contents 1196 0 R +/Resources 1194 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1161 0 R -/Annots [ 1168 0 R ] +/Parent 1174 0 R +/Annots [ 1193 0 R ] >> endobj -1168 0 obj << +1193 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [294.721 495.239 361.779 506.364] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -1172 0 obj << -/D [1170 0 R /XYZ 99.895 740.998 null] +1197 0 obj << +/D [1195 0 R /XYZ 99.895 740.998 null] >> endobj -262 0 obj << -/D [1170 0 R /XYZ 99.895 697.37 null] +270 0 obj << +/D [1195 0 R /XYZ 99.895 697.37 null] >> endobj -1173 0 obj << -/D [1170 0 R /XYZ 99.895 259.346 null] +1198 0 obj << +/D [1195 0 R /XYZ 99.895 259.346 null] >> endobj -1169 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F27 433 0 R /F8 434 0 R /F11 587 0 R >> +1194 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F27 441 0 R /F8 442 0 R /F11 597 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1177 0 obj << +1202 0 obj << /Length 3804 >> stream @@ -13244,43 +13469,43 @@ BT 0 g 0 G [-500(Otherwise)-288(the)-289(size)-288(of)]TJ/F30 9.9626 Tf 105.44 0 Td [(bndel)]TJ/F8 9.9626 Tf 29.024 0 Td [(will)-288(b)-28(e)-288(exactly)-288(e)-1(qu)1(al)-289(to)-288(the)-288(n)28(um)27(b)-27(er)-289(of)-288(b)-28(oun)1(d-)]TJ -121.734 -11.956 Td [(ary)-333(elemen)27(ts.)]TJ 0 g 0 G - 141.968 -208.758 Td [(82)]TJ + 141.968 -208.758 Td [(84)]TJ 0 g 0 G ET endstream endobj -1176 0 obj << +1201 0 obj << /Type /Page -/Contents 1177 0 R -/Resources 1175 0 R +/Contents 1202 0 R +/Resources 1200 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1161 0 R -/Annots [ 1174 0 R ] +/Parent 1174 0 R +/Annots [ 1199 0 R ] >> endobj -1174 0 obj << +1199 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [345.53 574.94 412.588 586.065] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -1178 0 obj << -/D [1176 0 R /XYZ 150.705 740.998 null] +1203 0 obj << +/D [1201 0 R /XYZ 150.705 740.998 null] >> endobj -266 0 obj << -/D [1176 0 R /XYZ 150.705 697.37 null] +274 0 obj << +/D [1201 0 R /XYZ 150.705 697.37 null] >> endobj -1179 0 obj << -/D [1176 0 R /XYZ 150.705 370.928 null] +1204 0 obj << +/D [1201 0 R /XYZ 150.705 370.928 null] >> endobj -1180 0 obj << -/D [1176 0 R /XYZ 150.705 327.092 null] +1205 0 obj << +/D [1201 0 R /XYZ 150.705 327.092 null] >> endobj -1175 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F27 433 0 R /F8 434 0 R >> +1200 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F27 441 0 R /F8 442 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1184 0 obj << +1209 0 obj << /Length 3654 >> stream @@ -13354,43 +13579,43 @@ BT 0 g 0 G [-500(Otherwise)-284(the)-284(size)-283(of)]TJ/F30 9.9626 Tf 105.261 0 Td [(ovrel)]TJ/F8 9.9626 Tf 28.979 0 Td [(will)-284(b)-27(e)-284(exactly)-284(equal)-284(to)-284(th)1(e)-284(n)28(um)27(b)-27(er)-284(of)-284(o)28(v)28(erlap)]TJ -121.51 -11.955 Td [(elemen)28(ts.)]TJ 0 g 0 G - 141.968 -220.714 Td [(83)]TJ + 141.968 -220.714 Td [(85)]TJ 0 g 0 G ET endstream endobj -1183 0 obj << +1208 0 obj << /Type /Page -/Contents 1184 0 R -/Resources 1182 0 R +/Contents 1209 0 R +/Resources 1207 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1161 0 R -/Annots [ 1181 0 R ] +/Parent 1213 0 R +/Annots [ 1206 0 R ] >> endobj -1181 0 obj << +1206 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [294.721 574.94 361.779 586.065] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -1185 0 obj << -/D [1183 0 R /XYZ 99.895 740.998 null] +1210 0 obj << +/D [1208 0 R /XYZ 99.895 740.998 null] >> endobj -270 0 obj << -/D [1183 0 R /XYZ 99.895 697.37 null] +278 0 obj << +/D [1208 0 R /XYZ 99.895 697.37 null] >> endobj -1186 0 obj << -/D [1183 0 R /XYZ 99.895 370.928 null] +1211 0 obj << +/D [1208 0 R /XYZ 99.895 370.928 null] >> endobj -1187 0 obj << -/D [1183 0 R /XYZ 99.895 339.047 null] +1212 0 obj << +/D [1208 0 R /XYZ 99.895 339.047 null] >> endobj -1182 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F27 433 0 R /F8 434 0 R >> +1207 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F27 441 0 R /F8 442 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1191 0 obj << +1217 0 obj << /Length 5790 >> stream @@ -13472,37 +13697,37 @@ BT 0 g 0 G /F8 9.9626 Tf 13.733 0 Td [(the)-333(ro)27(w)-333(indices.)]TJ 11.173 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 27.951 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf 23.073 0 Td [(.)]TJ -51.024 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 25.184 0 Td [(required)]TJ/F8 9.9626 Tf 41.898 0 Td [(.)]TJ -67.082 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(inout)]TJ/F8 9.9626 Tf 26.096 0 Td [(.)]TJ -59.582 -11.956 Td [(Sp)-28(eci\014ed)-333(as:)-445(an)-333(in)28(teger)-333(arra)27(y)-333(with)-333(the)]TJ/F30 9.9626 Tf 170.611 0 Td [(ALLOCATABLE)]TJ/F8 9.9626 Tf 60.854 0 Td [(attribute.)]TJ 0 g 0 G - -89.497 -29.887 Td [(84)]TJ + -89.497 -29.887 Td [(86)]TJ 0 g 0 G ET endstream endobj -1190 0 obj << +1216 0 obj << /Type /Page -/Contents 1191 0 R -/Resources 1189 0 R +/Contents 1217 0 R +/Resources 1215 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1161 0 R -/Annots [ 1188 0 R ] +/Parent 1213 0 R +/Annots [ 1214 0 R ] >> endobj -1188 0 obj << +1214 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [345.53 492.904 417.818 504.029] /Subtype /Link /A << /S /GoTo /D (spdata) >> >> endobj -1192 0 obj << -/D [1190 0 R /XYZ 150.705 740.998 null] +1218 0 obj << +/D [1216 0 R /XYZ 150.705 740.998 null] >> endobj -274 0 obj << -/D [1190 0 R /XYZ 150.705 696.587 null] +282 0 obj << +/D [1216 0 R /XYZ 150.705 696.587 null] >> endobj -1189 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F27 433 0 R /F8 434 0 R /F11 587 0 R >> +1215 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F27 441 0 R /F8 442 0 R /F11 597 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1195 0 obj << +1221 0 obj << /Length 3701 >> stream @@ -13534,35 +13759,35 @@ BT 0 g 0 G [-500(The)-253(ro)28(w)-252(and)-253(column)-253(ind)1(ic)-1(es)-252(are)-253(returned)-252(in)-253(the)-253(lo)-27(cal)-253(n)28(um)28(b)-28(ering)-253(sc)28(heme;)-280(if)]TJ 12.73 -11.955 Td [(the)-222(global)-222(n)27(um)28(b)-28(erin)1(g)-223(is)-222(desired,)-244(the)-223(user)-222(ma)28(y)-222(emplo)27(y)-222(the)]TJ/F30 9.9626 Tf 243.172 0 Td [(psb_loc_to_glob)]TJ/F8 9.9626 Tf -243.172 -11.955 Td [(routine)-333(on)-334(th)1(e)-334(output.)]TJ 0 g 0 G - 141.968 -290.909 Td [(85)]TJ + 141.968 -290.909 Td [(87)]TJ 0 g 0 G ET endstream endobj -1194 0 obj << +1220 0 obj << /Type /Page -/Contents 1195 0 R -/Resources 1193 0 R +/Contents 1221 0 R +/Resources 1219 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1200 0 R +/Parent 1213 0 R >> endobj -1196 0 obj << -/D [1194 0 R /XYZ 99.895 740.998 null] +1222 0 obj << +/D [1220 0 R /XYZ 99.895 740.998 null] >> endobj -1197 0 obj << -/D [1194 0 R /XYZ 99.895 496.913 null] +1223 0 obj << +/D [1220 0 R /XYZ 99.895 496.913 null] >> endobj -1198 0 obj << -/D [1194 0 R /XYZ 99.895 439.185 null] +1224 0 obj << +/D [1220 0 R /XYZ 99.895 439.185 null] >> endobj -1199 0 obj << -/D [1194 0 R /XYZ 99.895 418.983 null] +1225 0 obj << +/D [1220 0 R /XYZ 99.895 418.983 null] >> endobj -1193 0 obj << -/Font << /F27 433 0 R /F8 434 0 R /F30 601 0 R /F16 431 0 R /F11 587 0 R >> +1219 0 obj << +/Font << /F27 441 0 R /F8 442 0 R /F30 611 0 R /F16 439 0 R /F11 597 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1206 0 obj << +1231 0 obj << /Length 4125 >> stream @@ -13668,51 +13893,51 @@ BT 0 g 0 G /F8 9.9626 Tf 78.386 0 Td [(The)-332(memory)-331(o)-28(ccupation)-332(of)-331(the)-332(ob)-55(jec)-1(t)-331(sp)-28(eci\014ed)-332(in)-331(the)-332(calling)]TJ -53.48 -11.955 Td [(sequence,)-333(in)-334(b)28(ytes.)]TJ 0 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.955 Td [(Returned)-333(as:)-445(an)]TJ/F30 9.9626 Tf 73.835 0 Td [(integer\050psb_long_int_k_\051)]TJ/F8 9.9626 Tf 128.849 0 Td [(n)28(um)28(b)-28(er.)]TJ 0 g 0 G - -60.716 -242.632 Td [(86)]TJ + -60.716 -242.632 Td [(88)]TJ 0 g 0 G ET endstream endobj -1205 0 obj << +1230 0 obj << /Type /Page -/Contents 1206 0 R -/Resources 1204 0 R +/Contents 1231 0 R +/Resources 1229 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1200 0 R -/Annots [ 1201 0 R 1202 0 R 1203 0 R ] +/Parent 1213 0 R +/Annots [ 1226 0 R 1227 0 R 1228 0 R ] >> endobj -1201 0 obj << +1226 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [345.53 529.112 417.818 540.237] /Subtype /Link /A << /S /GoTo /D (spdata) >> >> endobj -1202 0 obj << +1227 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [345.53 461.366 412.588 472.491] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -1203 0 obj << +1228 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [372.153 405.575 439.211 416.7] /Subtype /Link /A << /S /GoTo /D (precdata) >> >> endobj -1207 0 obj << -/D [1205 0 R /XYZ 150.705 740.998 null] +1232 0 obj << +/D [1230 0 R /XYZ 150.705 740.998 null] >> endobj -278 0 obj << -/D [1205 0 R /XYZ 150.705 697.37 null] +286 0 obj << +/D [1230 0 R /XYZ 150.705 697.37 null] >> endobj -1204 0 obj << -/Font << /F16 431 0 R /F8 434 0 R /F30 601 0 R /F27 433 0 R /F11 587 0 R >> +1229 0 obj << +/Font << /F16 439 0 R /F8 442 0 R /F30 611 0 R /F27 441 0 R /F11 597 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1210 0 obj << +1235 0 obj << /Length 5754 >> stream @@ -13787,29 +14012,29 @@ BT 0 g 0 G /F8 9.9626 Tf 14.211 0 Td [(A)-333(v)27(ector)-333(of)-333(indices.)]TJ 10.696 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(Optional)]TJ/F8 9.9626 Tf -29.611 -11.955 Td [(An)-332(in)27(teger)-332(arra)28(y)-333(of)-332(rank)-333(1,)-332(whose)-333(en)28(tries)-332(are)-333(mo)28(v)28(ed)-333(to)-332(the)-333(same)-332(p)-28(osition)]TJ 0 -11.955 Td [(as)-333(the)-334(corresp)-28(on)1(ding)-334(en)28(tries)-333(in)]TJ/F11 9.9626 Tf 136.959 0 Td [(x)]TJ/F8 9.9626 Tf 5.694 0 Td [(.)]TJ 0 g 0 G - -0.685 -43.727 Td [(87)]TJ + -0.685 -43.727 Td [(89)]TJ 0 g 0 G ET endstream endobj -1209 0 obj << +1234 0 obj << /Type /Page -/Contents 1210 0 R -/Resources 1208 0 R +/Contents 1235 0 R +/Resources 1233 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1200 0 R +/Parent 1213 0 R >> endobj -1211 0 obj << -/D [1209 0 R /XYZ 99.895 740.998 null] +1236 0 obj << +/D [1234 0 R /XYZ 99.895 740.998 null] >> endobj -282 0 obj << -/D [1209 0 R /XYZ 99.895 696.813 null] +290 0 obj << +/D [1234 0 R /XYZ 99.895 696.813 null] >> endobj -1208 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F8 434 0 R /F11 587 0 R /F27 433 0 R >> +1233 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F8 442 0 R /F11 597 0 R /F27 441 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1214 0 obj << +1239 0 obj << /Length 7020 >> stream @@ -13910,53 +14135,53 @@ BT 0 g 0 G [-500(The)-358(merge-sort)-358(algorithm)-357(is)-358(implemen)28(ted)-358(to)-358(tak)28(e)-358(adv)56(an)28(tage)-358(of)-358(sub-)]TJ 17.158 -11.955 Td [(sequences)-401(that)-400(ma)28(y)-401(b)-28(e)-400(already)-401(in)-400(the)-401(desired)-400(ordering)-400(prior)-401(to)-400(the)]TJ 0 -11.956 Td [(subroutine)-246(call;)-275(this)-246(situation)-246(is)-247(relativ)28(ely)-246(common)-246(when)-246(dealing)-246(with)]TJ 0 -11.955 Td [(groups)-258(of)-257(indices)-258(of)-258(sparse)-258(matrix)-257(en)28(tries,)-273(th)28(us)-258(merge-sort)-258(is)-258(often)-257(the)]TJ 0 -11.955 Td [(preferred)-318(c)27(hoice)-318(when)-319(a)-318(sorting)-319(is)-318(needed)-319(b)28(y)-319(oth)1(e)-1(r)-318(routines)-318(in)-319(the)-318(li-)]TJ 0 -11.955 Td [(brary)83(.)]TJ 0 g 0 G - 120.05 -193.275 Td [(88)]TJ + 120.05 -193.275 Td [(90)]TJ 0 g 0 G ET endstream endobj -1213 0 obj << +1238 0 obj << /Type /Page -/Contents 1214 0 R -/Resources 1212 0 R +/Contents 1239 0 R +/Resources 1237 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1200 0 R +/Parent 1213 0 R >> endobj -1215 0 obj << -/D [1213 0 R /XYZ 150.705 740.998 null] +1240 0 obj << +/D [1238 0 R /XYZ 150.705 740.998 null] >> endobj -1216 0 obj << -/D [1213 0 R /XYZ 150.705 702.144 null] +1241 0 obj << +/D [1238 0 R /XYZ 150.705 702.144 null] >> endobj -1217 0 obj << -/D [1213 0 R /XYZ 150.705 668.326 null] +1242 0 obj << +/D [1238 0 R /XYZ 150.705 668.326 null] >> endobj -1218 0 obj << -/D [1213 0 R /XYZ 150.705 624.491 null] +1243 0 obj << +/D [1238 0 R /XYZ 150.705 624.491 null] >> endobj -1219 0 obj << -/D [1213 0 R /XYZ 150.705 556.745 null] +1244 0 obj << +/D [1238 0 R /XYZ 150.705 556.745 null] >> endobj -1220 0 obj << -/D [1213 0 R /XYZ 150.705 500.954 null] +1245 0 obj << +/D [1238 0 R /XYZ 150.705 500.954 null] >> endobj -1221 0 obj << -/D [1213 0 R /XYZ 150.705 468.52 null] +1246 0 obj << +/D [1238 0 R /XYZ 150.705 468.52 null] >> endobj -1222 0 obj << -/D [1213 0 R /XYZ 150.705 425.182 null] +1247 0 obj << +/D [1238 0 R /XYZ 150.705 425.182 null] >> endobj -1223 0 obj << -/D [1213 0 R /XYZ 150.705 383.395 null] +1248 0 obj << +/D [1238 0 R /XYZ 150.705 383.395 null] >> endobj -1224 0 obj << -/D [1213 0 R /XYZ 150.705 355.499 null] +1249 0 obj << +/D [1238 0 R /XYZ 150.705 355.499 null] >> endobj -1212 0 obj << -/Font << /F16 431 0 R /F8 434 0 R /F11 587 0 R /F14 604 0 R /F7 602 0 R >> +1237 0 obj << +/Font << /F16 439 0 R /F8 442 0 R /F11 597 0 R /F14 614 0 R /F7 612 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1227 0 obj << +1252 0 obj << /Length 181 >> stream @@ -13965,29 +14190,29 @@ stream BT /F16 14.3462 Tf 99.895 706.129 Td [(7)-1125(P)31(arallel)-375(en)31(vironmen)32(t)-375(routines)]TJ 0 g 0 G -/F8 9.9626 Tf 166.875 -615.691 Td [(89)]TJ +/F8 9.9626 Tf 166.875 -615.691 Td [(91)]TJ 0 g 0 G ET endstream endobj -1226 0 obj << +1251 0 obj << /Type /Page -/Contents 1227 0 R -/Resources 1225 0 R +/Contents 1252 0 R +/Resources 1250 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1200 0 R +/Parent 1254 0 R >> endobj -1228 0 obj << -/D [1226 0 R /XYZ 99.895 740.998 null] +1253 0 obj << +/D [1251 0 R /XYZ 99.895 740.998 null] >> endobj -286 0 obj << -/D [1226 0 R /XYZ 99.895 716.092 null] +294 0 obj << +/D [1251 0 R /XYZ 99.895 716.092 null] >> endobj -1225 0 obj << -/Font << /F16 431 0 R /F8 434 0 R >> +1250 0 obj << +/Font << /F16 439 0 R /F8 442 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1231 0 obj << +1257 0 obj << /Length 5573 >> stream @@ -14054,35 +14279,35 @@ BT 0 g 0 G [-500(It)-262(is)-262(an)-262(error)-262(to)-262(sp)-28(ecify)-262(a)-262(v)56(alue)-262(for)]TJ/F11 9.9626 Tf 159.87 0 Td [(np)]TJ/F8 9.9626 Tf 13.602 0 Td [(greater)-262(than)-262(the)-262(n)28(um)28(b)-28(er)-262(of)-262(pro)-28(cesses)]TJ -160.742 -11.955 Td [(a)28(v)55(ailable)-333(in)-333(the)-334(und)1(e)-1(r)1(lying)-334(base)-333(parallel)-333(en)27(viron)1(m)-1(en)28(t.)]TJ 0 g 0 G - 141.968 -97.177 Td [(90)]TJ + 141.968 -97.177 Td [(92)]TJ 0 g 0 G ET endstream endobj -1230 0 obj << +1256 0 obj << /Type /Page -/Contents 1231 0 R -/Resources 1229 0 R +/Contents 1257 0 R +/Resources 1255 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1200 0 R +/Parent 1254 0 R >> endobj -1232 0 obj << -/D [1230 0 R /XYZ 150.705 740.998 null] +1258 0 obj << +/D [1256 0 R /XYZ 150.705 740.998 null] >> endobj -290 0 obj << -/D [1230 0 R /XYZ 150.705 697.37 null] +298 0 obj << +/D [1256 0 R /XYZ 150.705 697.37 null] >> endobj -1233 0 obj << -/D [1230 0 R /XYZ 150.705 235.436 null] +1259 0 obj << +/D [1256 0 R /XYZ 150.705 235.436 null] >> endobj -1234 0 obj << -/D [1230 0 R /XYZ 150.705 213.573 null] +1260 0 obj << +/D [1256 0 R /XYZ 150.705 213.573 null] >> endobj -1229 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F8 434 0 R /F27 433 0 R /F11 587 0 R /F14 604 0 R >> +1255 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F8 442 0 R /F27 441 0 R /F11 597 0 R /F14 614 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1237 0 obj << +1263 0 obj << /Length 4646 >> stream @@ -14131,35 +14356,35 @@ BT 0 g 0 G [-500(If)-432(the)-433(user)-432(has)-433(requested)-432(on)]TJ/F30 9.9626 Tf 143.13 0 Td [(psb_init)]TJ/F8 9.9626 Tf 46.151 0 Td [(a)-432(n)27(um)28(b)-28(er)-432(of)-432(pro)-28(cesses)-433(less)-432(than)]TJ -176.551 -11.955 Td [(the)-417(total)-416(a)28(v)55(ailable)-416(in)-417(the)-416(parallel)-417(execution)-416(en)28(vironmen)28(t,)-438(the)-416(remaining)]TJ 0 -11.955 Td [(pro)-28(cesses)-359(will)-359(ha)28(v)28(e)-359(on)-359(return)]TJ/F11 9.9626 Tf 130.486 0 Td [(iam)]TJ/F8 9.9626 Tf 20.639 0 Td [(=)]TJ/F14 9.9626 Tf 10.941 0 Td [(\000)]TJ/F8 9.9626 Tf 7.749 0 Td [(1;)-372(the)-359(only)-359(call)-359(in)28(v)28(olving)]TJ/F30 9.9626 Tf 112.377 0 Td [(icontxt)]TJ/F8 9.9626 Tf -282.192 -11.956 Td [(that)-333(an)28(y)-334(suc)28(h)-333(pro)-28(cess)-334(ma)28(y)-333(execute)-334(is)-333(to)]TJ/F30 9.9626 Tf 177.086 0 Td [(psb_exit)]TJ/F8 9.9626 Tf 41.843 0 Td [(.)]TJ 0 g 0 G - -76.961 -174.885 Td [(91)]TJ + -76.961 -174.885 Td [(93)]TJ 0 g 0 G ET endstream endobj -1236 0 obj << +1262 0 obj << /Type /Page -/Contents 1237 0 R -/Resources 1235 0 R +/Contents 1263 0 R +/Resources 1261 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1241 0 R +/Parent 1254 0 R >> endobj -1238 0 obj << -/D [1236 0 R /XYZ 99.895 740.998 null] +1264 0 obj << +/D [1262 0 R /XYZ 99.895 740.998 null] >> endobj -294 0 obj << -/D [1236 0 R /XYZ 99.895 685.747 null] +302 0 obj << +/D [1262 0 R /XYZ 99.895 685.747 null] >> endobj -1239 0 obj << -/D [1236 0 R /XYZ 99.895 349.01 null] +1265 0 obj << +/D [1262 0 R /XYZ 99.895 349.01 null] >> endobj -1240 0 obj << -/D [1236 0 R /XYZ 99.895 315.192 null] +1266 0 obj << +/D [1262 0 R /XYZ 99.895 315.192 null] >> endobj -1235 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F8 434 0 R /F27 433 0 R /F14 604 0 R /F11 587 0 R >> +1261 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F8 442 0 R /F27 441 0 R /F14 614 0 R /F11 597 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1244 0 obj << +1269 0 obj << /Length 4354 >> stream @@ -14205,38 +14430,38 @@ BT 0 g 0 G [-500(If)-391(the)-390(user)-391(whishes)-391(to)-390(use)-391(m)28(ultiple)-391(comm)28(unication)-391(con)28(texts)-391(in)-390(the)-391(same)]TJ 12.73 -11.955 Td [(program,)-485(or)-455(to)-455(en)28(ter)-455(and)-454(exit)-455(m)27(u)1(ltiple)-455(times)-455(in)28(to)-455(the)-455(parallel)-455(en)28(viron-)]TJ 0 -11.955 Td [(men)28(t,)-494(this)-462(routine)-462(ma)28(y)-462(b)-28(e)-462(called)-462(to)-462(selectiv)28(ely)-462(close)-462(the)-462(con)27(texts)-462(with)]TJ/F30 9.9626 Tf 0 -11.955 Td [(close=.false.)]TJ/F8 9.9626 Tf 67.994 0 Td [(,)-244(while)-223(on)-222(the)-222(last)-222(call)-223(it)-222(should)-222(b)-28(e)-222(called)-222(with)]TJ/F30 9.9626 Tf 194.327 0 Td [(close=.true.)]TJ/F8 9.9626 Tf -262.321 -11.955 Td [(to)-333(sh)27(u)1(tdo)27(wn)-333(in)-333(a)-334(clean)-333(w)28(a)28(y)-334(the)-333(en)28(tire)-334(parallel)-333(en)28(vironmen)28(t.)]TJ 0 g 0 G - 141.967 -212.744 Td [(92)]TJ + 141.967 -212.744 Td [(94)]TJ 0 g 0 G ET endstream endobj -1243 0 obj << +1268 0 obj << /Type /Page -/Contents 1244 0 R -/Resources 1242 0 R +/Contents 1269 0 R +/Resources 1267 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1241 0 R +/Parent 1254 0 R >> endobj -1245 0 obj << -/D [1243 0 R /XYZ 150.705 740.998 null] +1270 0 obj << +/D [1268 0 R /XYZ 150.705 740.998 null] >> endobj -298 0 obj << -/D [1243 0 R /XYZ 150.705 697.37 null] +306 0 obj << +/D [1268 0 R /XYZ 150.705 697.37 null] >> endobj -1246 0 obj << -/D [1243 0 R /XYZ 150.705 442.659 null] +1271 0 obj << +/D [1268 0 R /XYZ 150.705 442.659 null] >> endobj -1247 0 obj << -/D [1243 0 R /XYZ 150.705 396.886 null] +1272 0 obj << +/D [1268 0 R /XYZ 150.705 396.886 null] >> endobj -1248 0 obj << -/D [1243 0 R /XYZ 150.705 365.005 null] +1273 0 obj << +/D [1268 0 R /XYZ 150.705 365.005 null] >> endobj -1242 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F8 434 0 R /F27 433 0 R /F11 587 0 R /F14 604 0 R >> +1267 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F8 442 0 R /F27 441 0 R /F11 597 0 R /F14 614 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1251 0 obj << +1276 0 obj << /Length 2160 >> stream @@ -14280,29 +14505,29 @@ BT 0 g 0 G /F8 9.9626 Tf 38.08 0 Td [(The)-377(MPI)-378(comm)28(unicator)-377(as)-1(so)-27(ciated)-378(with)-377(the)-378(PSBLAS)-377(virtual)-377(parallel)]TJ -13.173 -11.955 Td [(mac)28(hine.)]TJ 0 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(global)]TJ/F8 9.9626 Tf 29.756 0 Td [(.)]TJ -62.135 -11.956 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf 41.898 0 Td [(.)]TJ -71.509 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(out)]TJ/F8 9.9626 Tf 16.549 0 Td [(.)]TJ 0 g 0 G - 91.933 -366.168 Td [(93)]TJ + 91.933 -366.168 Td [(95)]TJ 0 g 0 G ET endstream endobj -1250 0 obj << +1275 0 obj << /Type /Page -/Contents 1251 0 R -/Resources 1249 0 R +/Contents 1276 0 R +/Resources 1274 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1241 0 R +/Parent 1254 0 R >> endobj -1252 0 obj << -/D [1250 0 R /XYZ 99.895 740.998 null] +1277 0 obj << +/D [1275 0 R /XYZ 99.895 740.998 null] >> endobj -302 0 obj << -/D [1250 0 R /XYZ 99.895 697.37 null] +310 0 obj << +/D [1275 0 R /XYZ 99.895 697.37 null] >> endobj -1249 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F8 434 0 R /F27 433 0 R >> +1274 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F8 442 0 R /F27 441 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1255 0 obj << +1280 0 obj << /Length 3024 >> stream @@ -14350,29 +14575,29 @@ BT 0 g 0 G /F8 9.9626 Tf 27.681 0 Td [(The)-333(MPI)-334(rank)-333(asso)-28(ciated)-333(with)-333(the)-334(PSBLAS)-333(pro)-28(cess)]TJ/F11 9.9626 Tf 230.248 0 Td [(id)]TJ/F8 9.9626 Tf 8.617 0 Td [(.)]TJ -241.639 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.378 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf 23.073 0 Td [(.)]TJ -55.451 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf 41.898 0 Td [(.)]TJ -71.509 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.485 0 Td [(out)]TJ/F8 9.9626 Tf 16.549 0 Td [(.)]TJ 0 g 0 G - 91.933 -322.333 Td [(94)]TJ + 91.933 -322.333 Td [(96)]TJ 0 g 0 G ET endstream endobj -1254 0 obj << +1279 0 obj << /Type /Page -/Contents 1255 0 R -/Resources 1253 0 R +/Contents 1280 0 R +/Resources 1278 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1241 0 R +/Parent 1254 0 R >> endobj -1256 0 obj << -/D [1254 0 R /XYZ 150.705 740.998 null] +1281 0 obj << +/D [1279 0 R /XYZ 150.705 740.998 null] >> endobj -306 0 obj << -/D [1254 0 R /XYZ 150.705 697.37 null] +314 0 obj << +/D [1279 0 R /XYZ 150.705 697.37 null] >> endobj -1253 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F8 434 0 R /F11 587 0 R /F27 433 0 R /F14 604 0 R >> +1278 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F8 442 0 R /F11 597 0 R /F27 441 0 R /F14 614 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1259 0 obj << +1284 0 obj << /Length 1180 >> stream @@ -14402,29 +14627,29 @@ BT 0 g 0 G /F8 9.9626 Tf 78.387 0 Td [(the)-333(elapsed)-334(time)-333(in)-333(seconds.)]TJ -53.48 -11.955 Td [(Returned)-333(as:)-445(a)]TJ/F30 9.9626 Tf 68.3 0 Td [(real\050psb_dpk_\051)]TJ/F8 9.9626 Tf 76.545 0 Td [(v)56(ariable.)]TJ 0 g 0 G - -2.877 -491.698 Td [(95)]TJ + -2.877 -491.698 Td [(97)]TJ 0 g 0 G ET endstream endobj -1258 0 obj << +1283 0 obj << /Type /Page -/Contents 1259 0 R -/Resources 1257 0 R +/Contents 1284 0 R +/Resources 1282 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1241 0 R +/Parent 1286 0 R >> endobj -1260 0 obj << -/D [1258 0 R /XYZ 99.895 740.998 null] +1285 0 obj << +/D [1283 0 R /XYZ 99.895 740.998 null] >> endobj -310 0 obj << -/D [1258 0 R /XYZ 99.895 697.37 null] +318 0 obj << +/D [1283 0 R /XYZ 99.895 697.37 null] >> endobj -1257 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F8 434 0 R /F27 433 0 R >> +1282 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F8 442 0 R /F27 441 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1263 0 obj << +1289 0 obj << /Length 1473 >> stream @@ -14454,29 +14679,29 @@ BT 0 g 0 G /F8 9.9626 Tf 39.989 0 Td [(the)-333(comm)27(unication)-333(con)28(text)-333(iden)27(tifyi)1(ng)-334(the)-333(virtual)-333(parallel)-334(mac)28(hine.)]TJ -15.082 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.378 0 Td [(global)]TJ/F8 9.9626 Tf 29.756 0 Td [(.)]TJ -62.134 -11.956 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf 41.898 0 Td [(.)]TJ -71.509 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.485 0 Td [(in)]TJ/F8 9.9626 Tf 9.548 0 Td [(.)]TJ -43.033 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-444(an)-334(in)28(teger)-333(v)55(ariable.)]TJ 0 g 0 G - 141.967 -455.832 Td [(96)]TJ + 141.967 -455.832 Td [(98)]TJ 0 g 0 G ET endstream endobj -1262 0 obj << +1288 0 obj << /Type /Page -/Contents 1263 0 R -/Resources 1261 0 R +/Contents 1289 0 R +/Resources 1287 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1241 0 R +/Parent 1286 0 R >> endobj -1264 0 obj << -/D [1262 0 R /XYZ 150.705 740.998 null] +1290 0 obj << +/D [1288 0 R /XYZ 150.705 740.998 null] >> endobj -314 0 obj << -/D [1262 0 R /XYZ 150.705 697.37 null] +322 0 obj << +/D [1288 0 R /XYZ 150.705 697.37 null] >> endobj -1261 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F8 434 0 R /F27 433 0 R >> +1287 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F8 442 0 R /F27 441 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1267 0 obj << +1293 0 obj << /Length 1359 >> stream @@ -14506,30 +14731,30 @@ BT 0 g 0 G /F8 9.9626 Tf 39.989 0 Td [(the)-333(comm)27(unication)-333(con)28(text)-333(iden)27(tifyin)1(g)-334(the)-333(virtual)-333(parallel)-334(mac)28(hine.)]TJ -15.082 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(global)]TJ/F8 9.9626 Tf 29.756 0 Td [(.)]TJ -62.135 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf 41.898 0 Td [(.)]TJ -71.509 -11.956 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(in)]TJ/F8 9.9626 Tf 9.547 0 Td [(.)]TJ -43.033 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-445(an)-333(in)28(teger)-333(v)55(ariable.)]TJ 0 g 0 G - 141.968 -467.787 Td [(97)]TJ + 141.968 -467.787 Td [(99)]TJ 0 g 0 G ET endstream endobj -1266 0 obj << +1292 0 obj << /Type /Page -/Contents 1267 0 R -/Resources 1265 0 R +/Contents 1293 0 R +/Resources 1291 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1269 0 R +/Parent 1286 0 R >> endobj -1268 0 obj << -/D [1266 0 R /XYZ 99.895 740.998 null] +1294 0 obj << +/D [1292 0 R /XYZ 99.895 740.998 null] >> endobj -318 0 obj << -/D [1266 0 R /XYZ 99.895 697.37 null] +326 0 obj << +/D [1292 0 R /XYZ 99.895 697.37 null] >> endobj -1265 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F8 434 0 R /F27 433 0 R >> +1291 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F8 442 0 R /F27 441 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1272 0 obj << -/Length 4532 +1297 0 obj << +/Length 4533 >> stream 0 g 0 G @@ -14573,29 +14798,29 @@ BT 0 g 0 G /F8 9.9626 Tf 21.371 0 Td [(On)-333(pro)-28(cesses)-334(other)-333(than)-333(ro)-28(ot,)-333(the)-334(dat)1(a)-334(to)-333(b)-28(e)-333(broadcast.)]TJ 3.536 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.378 0 Td [(global)]TJ/F8 9.9626 Tf 29.757 0 Td [(.)]TJ -62.135 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf 41.898 0 Td [(.)]TJ -71.509 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.485 0 Td [(inout)]TJ/F8 9.9626 Tf 26.097 0 Td [(.)]TJ -59.582 -11.955 Td [(Sp)-28(eci\014ed)-339(as:)-458(an)-339(in)28(tege)-1(r,)-341(real)-339(or)-340(complex)-340(v)56(ariable,)-342(whic)28(h)-339(m)-1(a)28(y)-339(b)-28(e)-340(a)-340(scalar,)]TJ 0 -11.955 Td [(or)-346(a)-346(rank)-347(1)-346(or)-346(2)-346(arra)28(y)83(,)-349(or)-347(a)-346(c)28(haracter)-346(or)-346(logical)-347(scalar.)-829(T)28(yp)-28(e,)-349(kind,)-350(rank)]TJ 0 -11.956 Td [(and)-333(size)-334(m)28(ust)-333(agree)-334(on)-333(all)-333(pro)-28(cesses.)]TJ 0 g 0 G - 141.967 -170.9 Td [(98)]TJ + 139.477 -170.9 Td [(100)]TJ 0 g 0 G ET endstream endobj -1271 0 obj << +1296 0 obj << /Type /Page -/Contents 1272 0 R -/Resources 1270 0 R +/Contents 1297 0 R +/Resources 1295 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1269 0 R +/Parent 1286 0 R >> endobj -1273 0 obj << -/D [1271 0 R /XYZ 150.705 740.998 null] +1298 0 obj << +/D [1296 0 R /XYZ 150.705 740.998 null] >> endobj -322 0 obj << -/D [1271 0 R /XYZ 150.705 697.37 null] +330 0 obj << +/D [1296 0 R /XYZ 150.705 697.37 null] >> endobj -1270 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F8 434 0 R /F27 433 0 R /F11 587 0 R /F14 604 0 R >> +1295 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F8 442 0 R /F27 441 0 R /F11 597 0 R /F14 614 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1276 0 obj << +1301 0 obj << /Length 5146 >> stream @@ -14648,35 +14873,35 @@ BT 0 g 0 G [-500(The)]TJ/F30 9.9626 Tf 33.209 0 Td [(dat)]TJ/F8 9.9626 Tf 19.012 0 Td [(argumen)28(t)-333(m)-1(a)28(y)-333(also)-333(b)-28(e)-334(a)-333(long)-333(in)28(teger)-334(scalar.)]TJ 0 g 0 G - 102.477 -109.132 Td [(99)]TJ + 99.986 -109.132 Td [(101)]TJ 0 g 0 G ET endstream endobj -1275 0 obj << +1300 0 obj << /Type /Page -/Contents 1276 0 R -/Resources 1274 0 R +/Contents 1301 0 R +/Resources 1299 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1269 0 R +/Parent 1286 0 R >> endobj -1277 0 obj << -/D [1275 0 R /XYZ 99.895 740.998 null] +1302 0 obj << +/D [1300 0 R /XYZ 99.895 740.998 null] >> endobj -326 0 obj << -/D [1275 0 R /XYZ 99.895 697.37 null] +334 0 obj << +/D [1300 0 R /XYZ 99.895 697.37 null] >> endobj -1278 0 obj << -/D [1275 0 R /XYZ 99.895 247.391 null] +1303 0 obj << +/D [1300 0 R /XYZ 99.895 247.391 null] >> endobj -1279 0 obj << -/D [1275 0 R /XYZ 99.895 213.573 null] +1304 0 obj << +/D [1300 0 R /XYZ 99.895 213.573 null] >> endobj -1274 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F8 434 0 R /F27 433 0 R /F14 604 0 R /F11 587 0 R >> +1299 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F8 442 0 R /F27 441 0 R /F14 614 0 R /F11 597 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1282 0 obj << +1307 0 obj << /Length 5185 >> stream @@ -14729,35 +14954,35 @@ BT 0 g 0 G [-500(The)]TJ/F30 9.9626 Tf 33.208 0 Td [(dat)]TJ/F8 9.9626 Tf 19.012 0 Td [(argumen)28(t)-334(ma)28(y)-333(also)-334(b)-27(e)-334(a)-333(long)-333(in)28(teger)-334(scalar.)]TJ 0 g 0 G - 99.987 -109.132 Td [(100)]TJ + 99.987 -109.132 Td [(102)]TJ 0 g 0 G ET endstream endobj -1281 0 obj << +1306 0 obj << /Type /Page -/Contents 1282 0 R -/Resources 1280 0 R +/Contents 1307 0 R +/Resources 1305 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1269 0 R +/Parent 1286 0 R >> endobj -1283 0 obj << -/D [1281 0 R /XYZ 150.705 740.998 null] +1308 0 obj << +/D [1306 0 R /XYZ 150.705 740.998 null] >> endobj -330 0 obj << -/D [1281 0 R /XYZ 150.705 697.37 null] +338 0 obj << +/D [1306 0 R /XYZ 150.705 697.37 null] >> endobj -1284 0 obj << -/D [1281 0 R /XYZ 150.705 247.391 null] +1309 0 obj << +/D [1306 0 R /XYZ 150.705 247.391 null] >> endobj -1285 0 obj << -/D [1281 0 R /XYZ 150.705 213.573 null] +1310 0 obj << +/D [1306 0 R /XYZ 150.705 213.573 null] >> endobj -1280 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F8 434 0 R /F27 433 0 R /F14 604 0 R /F11 587 0 R >> +1305 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F8 442 0 R /F27 441 0 R /F14 614 0 R /F11 597 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1288 0 obj << +1313 0 obj << /Length 5160 >> stream @@ -14810,35 +15035,35 @@ BT 0 g 0 G [-500(The)]TJ/F30 9.9626 Tf 33.209 0 Td [(dat)]TJ/F8 9.9626 Tf 19.012 0 Td [(argumen)28(t)-333(m)-1(a)28(y)-333(also)-333(b)-28(e)-334(a)-333(long)-333(in)28(teger)-334(scalar.)]TJ 0 g 0 G - 99.986 -109.132 Td [(101)]TJ + 99.986 -109.132 Td [(103)]TJ 0 g 0 G ET endstream endobj -1287 0 obj << +1312 0 obj << /Type /Page -/Contents 1288 0 R -/Resources 1286 0 R +/Contents 1313 0 R +/Resources 1311 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1269 0 R +/Parent 1317 0 R >> endobj -1289 0 obj << -/D [1287 0 R /XYZ 99.895 740.998 null] +1314 0 obj << +/D [1312 0 R /XYZ 99.895 740.998 null] >> endobj -334 0 obj << -/D [1287 0 R /XYZ 99.895 697.37 null] +342 0 obj << +/D [1312 0 R /XYZ 99.895 697.37 null] >> endobj -1290 0 obj << -/D [1287 0 R /XYZ 99.895 247.391 null] +1315 0 obj << +/D [1312 0 R /XYZ 99.895 247.391 null] >> endobj -1291 0 obj << -/D [1287 0 R /XYZ 99.895 213.573 null] +1316 0 obj << +/D [1312 0 R /XYZ 99.895 213.573 null] >> endobj -1286 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F8 434 0 R /F27 433 0 R /F14 604 0 R /F11 587 0 R >> +1311 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F8 442 0 R /F27 441 0 R /F14 614 0 R /F11 597 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1294 0 obj << +1320 0 obj << /Length 5277 >> stream @@ -14891,35 +15116,35 @@ BT 0 g 0 G [-500(The)]TJ/F30 9.9626 Tf 33.208 0 Td [(dat)]TJ/F8 9.9626 Tf 19.012 0 Td [(argumen)28(t)-334(ma)28(y)-333(also)-334(b)-27(e)-334(a)-333(long)-333(in)28(teger)-334(scalar.)]TJ 0 g 0 G - 99.987 -97.177 Td [(102)]TJ + 99.987 -97.177 Td [(104)]TJ 0 g 0 G ET endstream endobj -1293 0 obj << +1319 0 obj << /Type /Page -/Contents 1294 0 R -/Resources 1292 0 R +/Contents 1320 0 R +/Resources 1318 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1269 0 R +/Parent 1317 0 R >> endobj -1295 0 obj << -/D [1293 0 R /XYZ 150.705 740.998 null] +1321 0 obj << +/D [1319 0 R /XYZ 150.705 740.998 null] >> endobj -338 0 obj << -/D [1293 0 R /XYZ 150.705 697.37 null] +346 0 obj << +/D [1319 0 R /XYZ 150.705 697.37 null] >> endobj -1296 0 obj << -/D [1293 0 R /XYZ 150.705 235.436 null] +1322 0 obj << +/D [1319 0 R /XYZ 150.705 235.436 null] >> endobj -1297 0 obj << -/D [1293 0 R /XYZ 150.705 201.618 null] +1323 0 obj << +/D [1319 0 R /XYZ 150.705 201.618 null] >> endobj -1292 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F8 434 0 R /F27 433 0 R /F14 604 0 R /F11 587 0 R >> +1318 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F8 442 0 R /F27 441 0 R /F14 614 0 R /F11 597 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1300 0 obj << +1326 0 obj << /Length 5248 >> stream @@ -14972,35 +15197,35 @@ BT 0 g 0 G [-500(The)]TJ/F30 9.9626 Tf 33.209 0 Td [(dat)]TJ/F8 9.9626 Tf 19.012 0 Td [(argumen)28(t)-333(m)-1(a)28(y)-333(also)-333(b)-28(e)-334(a)-333(long)-333(in)28(teger)-334(scalar.)]TJ 0 g 0 G - 99.986 -97.177 Td [(103)]TJ + 99.986 -97.177 Td [(105)]TJ 0 g 0 G ET endstream endobj -1299 0 obj << +1325 0 obj << /Type /Page -/Contents 1300 0 R -/Resources 1298 0 R +/Contents 1326 0 R +/Resources 1324 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1304 0 R +/Parent 1317 0 R >> endobj -1301 0 obj << -/D [1299 0 R /XYZ 99.895 740.998 null] +1327 0 obj << +/D [1325 0 R /XYZ 99.895 740.998 null] >> endobj -342 0 obj << -/D [1299 0 R /XYZ 99.895 697.37 null] +350 0 obj << +/D [1325 0 R /XYZ 99.895 697.37 null] >> endobj -1302 0 obj << -/D [1299 0 R /XYZ 99.895 235.436 null] +1328 0 obj << +/D [1325 0 R /XYZ 99.895 235.436 null] >> endobj -1303 0 obj << -/D [1299 0 R /XYZ 99.895 201.618 null] +1329 0 obj << +/D [1325 0 R /XYZ 99.895 201.618 null] >> endobj -1298 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F8 434 0 R /F27 433 0 R /F14 604 0 R /F11 587 0 R >> +1324 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F8 442 0 R /F27 441 0 R /F14 614 0 R /F11 597 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1307 0 obj << +1332 0 obj << /Length 5369 >> stream @@ -15050,32 +15275,32 @@ BT 0 g 0 G [-500(This)-402(subroutine)-403(implies)-402(a)-402(sync)27(hronization,)-419(but)-403(on)1(ly)-403(b)-28(et)28(w)28(een)-403(th)1(e)-403(calling)]TJ 12.73 -11.955 Td [(pro)-28(cess)-333(and)-333(the)-334(destination)-333(pro)-28(cess)]TJ/F11 9.9626 Tf 157.52 0 Td [(dst)]TJ/F8 9.9626 Tf 13.453 0 Td [(.)]TJ 0 g 0 G - -31.496 -105.147 Td [(104)]TJ + -31.496 -105.147 Td [(106)]TJ 0 g 0 G ET endstream endobj -1306 0 obj << +1331 0 obj << /Type /Page -/Contents 1307 0 R -/Resources 1305 0 R +/Contents 1332 0 R +/Resources 1330 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1304 0 R +/Parent 1317 0 R >> endobj -1308 0 obj << -/D [1306 0 R /XYZ 150.705 740.998 null] +1333 0 obj << +/D [1331 0 R /XYZ 150.705 740.998 null] >> endobj -346 0 obj << -/D [1306 0 R /XYZ 150.705 697.37 null] +354 0 obj << +/D [1331 0 R /XYZ 150.705 697.37 null] >> endobj -1309 0 obj << -/D [1306 0 R /XYZ 150.705 223.48 null] +1334 0 obj << +/D [1331 0 R /XYZ 150.705 223.48 null] >> endobj -1305 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F8 434 0 R /F27 433 0 R /F11 587 0 R /F14 604 0 R >> +1330 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F8 442 0 R /F27 441 0 R /F11 597 0 R /F14 614 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1312 0 obj << +1337 0 obj << /Length 5352 >> stream @@ -15124,33 +15349,33 @@ BT 0 g 0 G [-500(This)-402(subroutine)-403(implies)-402(a)-402(s)-1(yn)1(c)27(hronization,)-419(but)-403(onl)1(y)-403(b)-28(et)28(w)28(een)-403(the)-402(calling)]TJ 12.73 -11.955 Td [(pro)-28(cess)-333(and)-333(the)-334(source)-333(pro)-28(cess)]TJ/F11 9.9626 Tf 136.516 0 Td [(sr)-28(c)]TJ/F8 9.9626 Tf 13.753 0 Td [(.)]TJ 0 g 0 G - -10.792 -105.147 Td [(105)]TJ + -10.792 -105.147 Td [(107)]TJ 0 g 0 G ET endstream endobj -1311 0 obj << +1336 0 obj << /Type /Page -/Contents 1312 0 R -/Resources 1310 0 R +/Contents 1337 0 R +/Resources 1335 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1304 0 R +/Parent 1317 0 R >> endobj -1313 0 obj << -/D [1311 0 R /XYZ 99.895 740.998 null] +1338 0 obj << +/D [1336 0 R /XYZ 99.895 740.998 null] >> endobj -350 0 obj << -/D [1311 0 R /XYZ 99.895 697.37 null] +358 0 obj << +/D [1336 0 R /XYZ 99.895 697.37 null] >> endobj -1314 0 obj << -/D [1311 0 R /XYZ 99.895 223.48 null] +1339 0 obj << +/D [1336 0 R /XYZ 99.895 223.48 null] >> endobj -1310 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F8 434 0 R /F27 433 0 R /F11 587 0 R /F14 604 0 R >> +1335 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F8 442 0 R /F27 441 0 R /F11 597 0 R /F14 614 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1319 0 obj << -/Length 6406 +1344 0 obj << +/Length 6407 >> stream 0 g 0 G @@ -15158,53 +15383,53 @@ stream BT /F16 14.3462 Tf 150.705 706.129 Td [(8)-1125(Error)-375(handling)]TJ/F8 9.9626 Tf 0 -21.821 Td [(The)-446(PSBLAS)-446(library)-446(error)-446(handling)-446(p)-28(olicy)-446(has)-446(b)-28(een)-446(completely)-446(rewritten)-446(in)]TJ 0 -11.955 Td [(v)28(ersion)-448(2.0.)-788(The)-448(idea)-448(b)-27(ehind)-448(the)-448(design)-448(of)-447(this)-448(new)-448(error)-448(handling)-447(strategy)]TJ 0 -11.955 Td [(is)-491(to)-492(k)28(eep)-491(error)-491(mes)-1(sages)-491(on)-491(a)-492(stac)28(k)-491(allo)28(wing)-492(th)1(e)-492(user)-491(to)-491(trace)-492(bac)28(k)-491(up)-492(t)1(o)]TJ 0 -11.956 Td [(the)-401(p)-27(oin)28(t)-401(where)-401(the)-400(\014rst)-401(error)-400(mes)-1(sage)-400(has)-401(b)-28(een)-400(generated.)-646(Ev)27(ery)-400(routine)-401(in)]TJ 0 -11.955 Td [(the)-442(P)1(SBLAS-2.0)-442(library)-441(has,)-469(as)-442(l)1(as)-1(t)-441(non-optional)-441(argumen)27(t,)-468(an)-442(in)28(teger)]TJ/F30 9.9626 Tf 322.79 0 Td [(info)]TJ/F8 9.9626 Tf -322.79 -11.955 Td [(v)56(ariable;)-385(whenev)28(er,)-376(inside)-368(the)-367(routine,)-376(an)-368(error)-367(is)-368(detected,)-376(this)-367(v)55(ariab)1(le)-368(is)-368(set)]TJ 0 -11.955 Td [(to)-381(a)-380(v)55(alu)1(e)-381(corresp)-28(onding)-380(to)-381(a)-380(sp)-28(eci\014c)-381(error)-380(co)-28(de.)-586(Then)-381(this)-380(error)-381(co)-28(de)-380(is)-381(also)]TJ 0 -11.955 Td [(pushed)-245(on)-245(the)-245(error)-245(stac)28(k)-245(and)-245(then)-245(either)-245(con)27(tr)1(ol)-245(is)-246(retur)1(ned)-245(to)-246(th)1(e)-246(caller)-245(routin)1(e)]TJ 0 -11.955 Td [(or)-372(the)-371(e)-1(xecution)-371(is)-372(ab)-28(orted,)-381(dep)-28(ending)-372(on)-371(the)-372(users)-372(c)28(hoice.)-560(A)28(t)-372(the)-372(time)-371(when)]TJ 0 -11.956 Td [(the)-364(execution)-363(is)-364(ab)-28(orted,)-371(an)-364(error)-364(message)-363(is)-364(prin)28(ted)-364(on)-364(standard)-363(output)-364(with)]TJ 0 -11.955 Td [(a)-448(lev)28(el)-448(of)-447(v)27(erb)-27(osit)27(y)-447(than)-448(can)-448(b)-27(e)-448(c)28(hosen)-448(b)28(y)-448(the)-448(user.)-787(If)-448(the)-448(execution)-447(is)-448(not)]TJ 0 -11.955 Td [(ab)-28(orted,)-328(then,)-329(the)-328(caller)-327(routine)-328(c)28(hec)28(ks)-328(the)-327(v)55(alue)-327(returned)-328(in)-327(the)]TJ/F30 9.9626 Tf 285.459 0 Td [(info)]TJ/F8 9.9626 Tf 24.185 0 Td [(v)56(ariable)]TJ -309.644 -11.955 Td [(and,)-359(if)-354(not)-354(zero,)-359(an)-353(error)-354(condition)-354(is)-354(raised.)-506(This)-354(pro)-28(cess)-354(con)28(tin)28(ues)-354(on)-354(all)-354(th)1(e)]TJ 0 -11.955 Td [(lev)28(els)-297(of)-296(nes)-1(ted)-296(calls)-297(un)28(til)-297(the)-296(lev)28(el)-297(where)-297(the)-296(user)-297(decides)-297(to)-296(ab)-28(ort)-297(the)-296(program)]TJ 0 -11.955 Td [(execution.)]TJ 14.944 -11.956 Td [(Figure)]TJ 0 0 1 rg 0 0 1 RG - [-353(8)]TJ + [-353(9)]TJ 0 g 0 G [-353(sho)28(ws)-353(the)-353(la)28(y)27(out)-353(of)-352(a)-353(ge)-1(n)1(e)-1(ri)1(c)]TJ/F30 9.9626 Tf 170.683 0 Td [(psb_foo)]TJ/F8 9.9626 Tf 40.129 0 Td [(routine)-353(with)-353(resp)-28(ect)-353(to)-353(the)]TJ -225.756 -11.955 Td [(PSBLAS-2.0)-326(error)-326(hand)1(ling)-326(p)-28(olicy)83(.)-442(It)-325(is)-326(p)-28(ossible)-326(to)-326(see)-326(ho)28(w,)-327(whenev)28(e)-1(r)-325(an)-326(error)]TJ 0 -11.955 Td [(condition)-379(is)-378(detected,)-390(the)]TJ/F30 9.9626 Tf 115.439 0 Td [(info)]TJ/F8 9.9626 Tf 24.694 0 Td [(v)56(ariable)-379(is)-379(set)-379(to)-378(the)-379(corresp)-28(onding)-378(error)-379(co)-28(de)]TJ -140.133 -11.955 Td [(whic)28(h)-376(is,)-387(then,)-386(pushed)-376(on)-376(top)-376(of)-376(the)-376(stac)28(k)-376(b)28(y)-376(means)-376(of)-376(the)]TJ/F30 9.9626 Tf 264.702 0 Td [(psb_errpush)]TJ/F8 9.9626 Tf 57.534 0 Td [(.)-572(An)]TJ -322.236 -11.955 Td [(error)-331(condition)-331(ma)28(y)-331(b)-28(e)-331(directly)-331(detected)-331(inside)-331(a)-331(routine)-331(or)-331(indirectly)-331(c)27(h)1(e)-1(c)28(king)]TJ 0 -11.956 Td [(the)-461(e)-1(rr)1(or)-462(co)-28(de)-461(returned)-462(returned)-461(b)28(y)-462(a)-461(called)-462(routine.)-829(Whenev)28(er)-461(an)-462(error)-461(is)]TJ 0 -11.955 Td [(encoun)28(tered,)-459(after)-434(it)-434(has)-433(b)-28(een)-434(pushed)-434(on)-434(stac)28(k,)-459(the)-434(program)-433(execution)-434(skips)]TJ 0 -11.955 Td [(to)-356(a)-356(p)-27(oin)28(t)-356(where)-356(the)-356(error)-355(condition)-356(is)-356(handled;)-367(the)-355(error)-356(condition)-356(is)-356(han)1(dled)]TJ 0 -11.955 Td [(either)-392(b)28(y)-392(returning)-392(con)28(trol)-392(to)-392(the)-392(caller)-391(routine)-392(or)-392(b)28(y)-392(calling)-392(the)]TJ/F30 9.9626 Tf 291.408 0 Td [(psb\134_error)]TJ/F8 9.9626 Tf -291.408 -11.955 Td [(routine)-478(whic)28(h)-479(pr)1(in)27(ts)-478(the)-478(con)28(ten)27(t)-478(of)-478(the)-478(error)-478(s)-1(tac)28(k)-478(and)-478(ab)-28(orts)-478(the)-478(program)]TJ 0 -11.955 Td [(execution,)-329(ac)-1(cord)1(ing)-329(to)-328(the)-329(c)28(hoice)-329(made)-328(b)27(y)-328(the)-329(user)-328(with)]TJ/F30 9.9626 Tf 252.028 0 Td [(psb_set_erraction)]TJ/F8 9.9626 Tf 88.916 0 Td [(.)]TJ -340.944 -11.956 Td [(The)-347(default)-346(is)-347(to)-346(prin)28(t)-347(the)-347(error)-346(and)-347(terminate)-346(the)-347(program,)-350(but)-346(the)-347(user)-346(ma)27(y)]TJ 0 -11.955 Td [(c)28(ho)-28(ose)-333(to)-334(handle)-333(the)-333(error)-334(explicitly)84(.)]TJ 14.944 -11.955 Td [(Figure)]TJ 0 0 1 rg 0 0 1 RG - [-400(9)]TJ + [-479(10)]TJ 0 g 0 G - [-400(rep)-28(orts)-400(a)-401(sample)-400(error)-400(message)-401(generated)-400(b)28(y)-400(the)-401(PSBLAS-2.0)-400(li-)]TJ -14.944 -11.955 Td [(brary)83(.)-555(This)-370(error)-370(has)-371(b)-28(een)-370(generated)-370(b)28(y)-371(the)-370(fact)-370(that)-371(the)-370(user)-370(has)-371(c)28(hosen)-370(the)]TJ 0 -11.955 Td [(in)28(v)55(alid)-367(\134F)28(OO")-368(storage)-367(format)-368(to)-367(represen)27(t)-367(the)-368(sparse)-367(matrix.)-547(F)83(rom)-367(this)-368(error)]TJ 0 -11.955 Td [(message)-248(it)-248(is)-248(p)-27(oss)-1(i)1(ble)-248(to)-248(see)-248(that)-248(the)-248(error)-247(has)-248(b)-28(een)-248(detected)-248(inside)-248(th)1(e)]TJ/F30 9.9626 Tf 301.868 0 Td [(psb_cest)]TJ/F8 9.9626 Tf -301.868 -11.956 Td [(subroutine)-333(called)-334(b)28(y)]TJ/F30 9.9626 Tf 91.407 0 Td [(psb_spasb)]TJ/F8 9.9626 Tf 50.394 0 Td [(...)-444(b)27(y)-333(pro)-28(cess)-333(0)-333(\050i.e.)-445(the)-333(ro)-28(ot)-333(pro)-28(cess\051.)]TJ + [-479(rep)-28(orts)-479(a)-479(sample)-480(error)-479(message)-479(generated)-479(b)28(y)-480(the)-479(PSBLAS-2.0)]TJ -14.944 -11.955 Td [(library)83(.)-451(This)-335(error)-336(has)-335(b)-28(een)-336(generated)-335(b)27(y)-335(the)-336(fact)-335(that)-336(the)-335(use)-1(r)-335(has)-336(c)28(hosen)-336(th)1(e)]TJ 0 -11.955 Td [(in)28(v)55(alid)-367(\134F)28(OO")-368(storage)-367(format)-368(to)-367(represen)27(t)-367(the)-368(sparse)-367(matrix.)-547(F)83(rom)-367(this)-368(error)]TJ 0 -11.955 Td [(message)-248(it)-248(is)-248(p)-27(oss)-1(i)1(ble)-248(to)-248(see)-248(that)-248(the)-248(error)-247(has)-248(b)-28(een)-248(detected)-248(inside)-248(th)1(e)]TJ/F30 9.9626 Tf 301.868 0 Td [(psb_cest)]TJ/F8 9.9626 Tf -301.868 -11.956 Td [(subroutine)-333(called)-334(b)28(y)]TJ/F30 9.9626 Tf 91.407 0 Td [(psb_spasb)]TJ/F8 9.9626 Tf 50.394 0 Td [(...)-444(b)27(y)-333(pro)-28(cess)-333(0)-333(\050i.e.)-445(the)-333(ro)-28(ot)-333(pro)-28(cess\051.)]TJ 0 g 0 G - 22.583 -211.304 Td [(106)]TJ + 22.583 -211.304 Td [(108)]TJ 0 g 0 G ET endstream endobj -1318 0 obj << +1343 0 obj << /Type /Page -/Contents 1319 0 R -/Resources 1317 0 R +/Contents 1344 0 R +/Resources 1342 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1304 0 R -/Annots [ 1315 0 R 1316 0 R ] +/Parent 1317 0 R +/Annots [ 1340 0 R 1341 0 R ] >> endobj -1315 0 obj << +1340 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [196.286 501.77 203.26 512.895] /Subtype /Link -/A << /S /GoTo /D (figure.8) >> ->> endobj -1316 0 obj << -/Type /Annot -/Border[0 0 0]/H/I/C[1 0 0] -/Rect [196.757 346.63 203.731 357.478] -/Subtype /Link /A << /S /GoTo /D (figure.9) >> >> endobj -1320 0 obj << -/D [1318 0 R /XYZ 150.705 740.998 null] +1341 0 obj << +/Type /Annot +/Border[0 0 0]/H/I/C[1 0 0] +/Rect [197.543 346.63 209.498 357.478] +/Subtype /Link +/A << /S /GoTo /D (figure.10) >> >> endobj -354 0 obj << -/D [1318 0 R /XYZ 150.705 716.092 null] +1345 0 obj << +/D [1343 0 R /XYZ 150.705 740.998 null] >> endobj -1317 0 obj << -/Font << /F16 431 0 R /F8 434 0 R /F30 601 0 R >> +362 0 obj << +/D [1343 0 R /XYZ 150.705 716.092 null] +>> endobj +1342 0 obj << +/Font << /F16 439 0 R /F8 442 0 R /F30 611 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1325 0 obj << -/Length 3859 +1350 0 obj << +/Length 3853 >> stream 0 g 0 G @@ -15234,7 +15459,7 @@ q []0 d 0 J 0.398 w 0 0 m 346.583 0 l S Q BT -/F8 9.9626 Tf 99.895 400.281 Td [(Figure)-329(8:)-443(The)-329(la)27(y)28(out)-329(of)-330(a)-329(generic)]TJ/F30 9.9626 Tf 147.445 0 Td [(psb)]TJ +/F8 9.9626 Tf 99.895 400.281 Td [(Figure)-329(9:)-443(The)-329(la)27(y)28(out)-329(of)-330(a)-329(generic)]TJ/F30 9.9626 Tf 147.445 0 Td [(psb)]TJ ET q 1 0 0 1 263.659 400.481 cm @@ -15269,7 +15494,7 @@ q []0 d 0 J 0.398 w 0 0 m 346.583 0 l S Q BT -/F8 9.9626 Tf 99.895 159.118 Td [(Figure)-422(9:)-622(A)-422(sample)-422(PSBLAS-2.0)-422(error)-422(message.)-711(Pr)1(o)-28(cess)-422(0)-422(dete)-1(cted)-422(an)-422(error)]TJ 0 -11.955 Td [(condition)-333(inside)-334(the)-333(psb)]TJ +/F8 9.9626 Tf 99.895 159.118 Td [(Figure)-386(10:)-551(A)-386(sample)-386(PSBLAS-2.0)-387(error)-386(message.)-603(Pro)-28(cess)-387(0)-386(detected)-386(an)-387(error)]TJ 0 -11.955 Td [(condition)-333(inside)-334(the)-333(psb)]TJ ET q 1 0 0 1 204.658 147.362 cm @@ -15279,32 +15504,32 @@ BT /F8 9.9626 Tf 207.647 147.163 Td [(cest)-333(s)-1(u)1(broutine)]TJ 0 g 0 G 0 g 0 G - 56.632 -56.725 Td [(107)]TJ + 56.632 -56.725 Td [(109)]TJ 0 g 0 G ET endstream endobj -1324 0 obj << +1349 0 obj << /Type /Page -/Contents 1325 0 R -/Resources 1323 0 R +/Contents 1350 0 R +/Resources 1348 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1304 0 R +/Parent 1352 0 R >> endobj -1326 0 obj << -/D [1324 0 R /XYZ 99.895 740.998 null] +1351 0 obj << +/D [1349 0 R /XYZ 99.895 740.998 null] >> endobj -1321 0 obj << -/D [1324 0 R /XYZ 143.452 412.237 null] +1346 0 obj << +/D [1349 0 R /XYZ 143.452 412.237 null] >> endobj -1322 0 obj << -/D [1324 0 R /XYZ 146.161 171.074 null] +1347 0 obj << +/D [1349 0 R /XYZ 150.074 171.074 null] >> endobj -1323 0 obj << -/Font << /F46 726 0 R /F8 434 0 R /F30 601 0 R >> +1348 0 obj << +/Font << /F46 756 0 R /F8 442 0 R /F30 611 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1329 0 obj << +1355 0 obj << /Length 2958 >> stream @@ -15374,29 +15599,29 @@ BT 0 g 0 G /F8 9.9626 Tf 19.669 0 Td [(addional)-333(info)-333(for)-334(error)-333(co)-28(de)]TJ -4.457 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.612 0 Td [(optional)]TJ/F8 9.9626 Tf -29.612 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-445(a)-333(string.)]TJ 0 g 0 G - 139.477 -284.475 Td [(108)]TJ + 139.477 -284.475 Td [(110)]TJ 0 g 0 G ET endstream endobj -1328 0 obj << +1354 0 obj << /Type /Page -/Contents 1329 0 R -/Resources 1327 0 R +/Contents 1355 0 R +/Resources 1353 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1304 0 R +/Parent 1352 0 R >> endobj -1330 0 obj << -/D [1328 0 R /XYZ 150.705 740.998 null] +1356 0 obj << +/D [1354 0 R /XYZ 150.705 740.998 null] >> endobj -358 0 obj << -/D [1328 0 R /XYZ 150.705 697.37 null] +366 0 obj << +/D [1354 0 R /XYZ 150.705 697.37 null] >> endobj -1327 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F27 433 0 R /F8 434 0 R >> +1353 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F27 441 0 R /F8 442 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1333 0 obj << +1359 0 obj << /Length 1151 >> stream @@ -15426,29 +15651,29 @@ BT 0 g 0 G /F8 9.9626 Tf 39.989 0 Td [(the)-333(comm)27(unication)-333(con)28(text.)]TJ -15.082 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(global)]TJ/F8 9.9626 Tf -32.379 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(optional)]TJ/F8 9.9626 Tf -29.611 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(in)]TJ/F8 9.9626 Tf 9.547 0 Td [(.)]TJ -43.033 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-445(an)-333(in)28(teger.)]TJ 0 g 0 G - 139.477 -473.765 Td [(109)]TJ + 139.477 -473.765 Td [(111)]TJ 0 g 0 G ET endstream endobj -1332 0 obj << +1358 0 obj << /Type /Page -/Contents 1333 0 R -/Resources 1331 0 R +/Contents 1359 0 R +/Resources 1357 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1335 0 R +/Parent 1352 0 R >> endobj -1334 0 obj << -/D [1332 0 R /XYZ 99.895 740.998 null] +1360 0 obj << +/D [1358 0 R /XYZ 99.895 740.998 null] >> endobj -362 0 obj << -/D [1332 0 R /XYZ 99.895 685.747 null] +370 0 obj << +/D [1358 0 R /XYZ 99.895 685.747 null] >> endobj -1331 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F27 433 0 R /F8 434 0 R >> +1357 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F27 441 0 R /F8 442 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1338 0 obj << +1363 0 obj << /Length 1249 >> stream @@ -15485,29 +15710,29 @@ BT 0 g 0 G /F8 9.9626 Tf 11.028 0 Td [(the)-333(v)27(erb)-27(osit)27(y)-333(lev)28(el)]TJ 13.878 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(global)]TJ/F8 9.9626 Tf -32.379 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.612 0 Td [(required)]TJ/F8 9.9626 Tf -29.612 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(in)]TJ/F8 9.9626 Tf 9.548 0 Td [(.)]TJ -43.034 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-445(an)-333(in)28(teger.)]TJ 0 g 0 G - 139.477 -473.765 Td [(110)]TJ + 139.477 -473.765 Td [(112)]TJ 0 g 0 G ET endstream endobj -1337 0 obj << +1362 0 obj << /Type /Page -/Contents 1338 0 R -/Resources 1336 0 R +/Contents 1363 0 R +/Resources 1361 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1335 0 R +/Parent 1352 0 R >> endobj -1339 0 obj << -/D [1337 0 R /XYZ 150.705 740.998 null] +1364 0 obj << +/D [1362 0 R /XYZ 150.705 740.998 null] >> endobj -366 0 obj << -/D [1337 0 R /XYZ 150.705 683.422 null] +374 0 obj << +/D [1362 0 R /XYZ 150.705 683.422 null] >> endobj -1336 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F27 433 0 R /F8 434 0 R >> +1361 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F27 441 0 R /F8 442 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1342 0 obj << +1367 0 obj << /Length 1710 >> stream @@ -15554,29 +15779,29 @@ BT 0 g 0 G /F30 9.9626 Tf -336.792 -21.918 Td [(call)-525(psb_errcomm\050icontxt,)-525(err\051)]TJ 0 g 0 G -/F8 9.9626 Tf 164.384 -451.847 Td [(111)]TJ +/F8 9.9626 Tf 164.384 -451.847 Td [(113)]TJ 0 g 0 G ET endstream endobj -1341 0 obj << +1366 0 obj << /Type /Page -/Contents 1342 0 R -/Resources 1340 0 R +/Contents 1367 0 R +/Resources 1365 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1335 0 R +/Parent 1352 0 R >> endobj -1343 0 obj << -/D [1341 0 R /XYZ 99.895 740.998 null] +1368 0 obj << +/D [1366 0 R /XYZ 99.895 740.998 null] >> endobj -370 0 obj << -/D [1341 0 R /XYZ 99.895 685.747 null] +378 0 obj << +/D [1366 0 R /XYZ 99.895 685.747 null] >> endobj -1340 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F27 433 0 R /F8 434 0 R >> +1365 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F27 441 0 R /F8 442 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1346 0 obj << +1371 0 obj << /Length 526 >> stream @@ -15585,29 +15810,29 @@ stream BT /F16 14.3462 Tf 150.705 706.129 Td [(9)-1125(Utilities)]TJ/F8 9.9626 Tf 0 -21.821 Td [(W)83(e)-414(ha)27(v)28(e)-415(some)-414(utitlities)-415(a)28(v)55(ailable)-414(for)-415(input)-415(and)-414(output)-415(of)-415(sparsematrices;)-455(the)]TJ 0 -11.955 Td [(in)28(terfaces)-334(to)-333(these)-333(routines)-334(are)-333(a)28(v)55(ailable)-333(in)-333(the)-334(mo)-27(dule)]TJ/F30 9.9626 Tf 241.843 0 Td [(psb_util_mod)]TJ/F8 9.9626 Tf 62.764 0 Td [(.)]TJ 0 g 0 G - -140.224 -581.915 Td [(112)]TJ + -140.224 -581.915 Td [(114)]TJ 0 g 0 G ET endstream endobj -1345 0 obj << +1370 0 obj << /Type /Page -/Contents 1346 0 R -/Resources 1344 0 R +/Contents 1371 0 R +/Resources 1369 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1335 0 R +/Parent 1352 0 R >> endobj -1347 0 obj << -/D [1345 0 R /XYZ 150.705 740.998 null] +1372 0 obj << +/D [1370 0 R /XYZ 150.705 740.998 null] >> endobj -374 0 obj << -/D [1345 0 R /XYZ 150.705 716.092 null] +382 0 obj << +/D [1370 0 R /XYZ 150.705 716.092 null] >> endobj -1344 0 obj << -/Font << /F16 431 0 R /F8 434 0 R /F30 601 0 R >> +1369 0 obj << +/Font << /F16 439 0 R /F8 442 0 R /F30 611 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1351 0 obj << +1376 0 obj << /Length 4442 >> stream @@ -15678,37 +15903,37 @@ BT 0 g 0 G /F8 9.9626 Tf 22.589 0 Td [(Error)-333(co)-28(de.)]TJ 2.318 -11.956 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf -29.611 -11.955 Td [(An)-333(in)28(tege)-1(r)-333(v)56(alue;)-334(0)-333(means)-333(no)-334(error)-333(has)-333(b)-28(een)-333(detecte)-1(d)1(.)]TJ 0 g 0 G - 139.477 -196.803 Td [(113)]TJ + 139.477 -196.803 Td [(115)]TJ 0 g 0 G ET endstream endobj -1350 0 obj << +1375 0 obj << /Type /Page -/Contents 1351 0 R -/Resources 1349 0 R +/Contents 1376 0 R +/Resources 1374 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1335 0 R -/Annots [ 1348 0 R ] +/Parent 1378 0 R +/Annots [ 1373 0 R ] >> endobj -1348 0 obj << +1373 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [294.721 451.404 367.009 462.529] /Subtype /Link /A << /S /GoTo /D (spdata) >> >> endobj -1352 0 obj << -/D [1350 0 R /XYZ 99.895 740.998 null] +1377 0 obj << +/D [1375 0 R /XYZ 99.895 740.998 null] >> endobj -378 0 obj << -/D [1350 0 R /XYZ 99.895 683.422 null] +386 0 obj << +/D [1375 0 R /XYZ 99.895 683.422 null] >> endobj -1349 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F27 433 0 R /F8 434 0 R >> +1374 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F27 441 0 R /F8 442 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1356 0 obj << +1382 0 obj << /Length 4868 >> stream @@ -15783,37 +16008,37 @@ BT 0 g 0 G /F8 9.9626 Tf 22.589 0 Td [(Error)-333(co)-28(de.)]TJ 2.318 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf -29.611 -11.956 Td [(An)-333(in)28(tege)-1(r)-333(v)56(alue;)-334(0)-333(means)-333(no)-334(error)-333(has)-333(b)-28(een)-333(detected.)]TJ 0 g 0 G - 139.477 -141.012 Td [(114)]TJ + 139.477 -141.012 Td [(116)]TJ 0 g 0 G ET endstream endobj -1355 0 obj << +1381 0 obj << /Type /Page -/Contents 1356 0 R -/Resources 1354 0 R +/Contents 1382 0 R +/Resources 1380 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1335 0 R -/Annots [ 1353 0 R ] +/Parent 1378 0 R +/Annots [ 1379 0 R ] >> endobj -1353 0 obj << +1379 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [345.53 584.903 417.818 596.028] /Subtype /Link /A << /S /GoTo /D (spdata) >> >> endobj -1357 0 obj << -/D [1355 0 R /XYZ 150.705 740.998 null] +1383 0 obj << +/D [1381 0 R /XYZ 150.705 740.998 null] >> endobj -382 0 obj << -/D [1355 0 R /XYZ 150.705 683.422 null] +390 0 obj << +/D [1381 0 R /XYZ 150.705 683.422 null] >> endobj -1354 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F27 433 0 R /F8 434 0 R >> +1380 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F27 441 0 R /F8 442 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1361 0 obj << +1387 0 obj << /Length 3234 >> stream @@ -15883,37 +16108,37 @@ BT 0 g 0 G /F8 9.9626 Tf 22.589 0 Td [(Error)-333(co)-28(de.)]TJ 2.318 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf -29.611 -11.955 Td [(An)-333(in)28(tege)-1(r)-333(v)56(alue;)-334(0)-333(means)-333(no)-334(error)-333(has)-333(b)-28(een)-333(detecte)-1(d)1(.)]TJ 0 g 0 G - 139.477 -320.34 Td [(115)]TJ + 139.477 -320.34 Td [(117)]TJ 0 g 0 G ET endstream endobj -1360 0 obj << +1386 0 obj << /Type /Page -/Contents 1361 0 R -/Resources 1359 0 R +/Contents 1387 0 R +/Resources 1385 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1363 0 R -/Annots [ 1358 0 R ] +/Parent 1378 0 R +/Annots [ 1384 0 R ] >> endobj -1358 0 obj << +1384 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [294.721 451.404 367.009 462.529] /Subtype /Link /A << /S /GoTo /D (spdata) >> >> endobj -1362 0 obj << -/D [1360 0 R /XYZ 99.895 740.998 null] +1388 0 obj << +/D [1386 0 R /XYZ 99.895 740.998 null] >> endobj -386 0 obj << -/D [1360 0 R /XYZ 99.895 685.747 null] +394 0 obj << +/D [1386 0 R /XYZ 99.895 685.747 null] >> endobj -1359 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F27 433 0 R /F8 434 0 R >> +1385 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F27 441 0 R /F8 442 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1366 0 obj << +1391 0 obj << /Length 3263 >> stream @@ -15965,29 +16190,29 @@ BT 0 g 0 G /F8 9.9626 Tf 22.589 0 Td [(Error)-333(co)-28(de.)]TJ 2.318 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf -29.611 -11.955 Td [(An)-333(in)28(tege)-1(r)-333(v)56(alue;)-334(0)-333(means)-333(no)-334(error)-333(has)-333(b)-28(een)-333(detected.)]TJ 0 g 0 G - 139.477 -296.43 Td [(116)]TJ + 139.477 -296.43 Td [(118)]TJ 0 g 0 G ET endstream endobj -1365 0 obj << +1390 0 obj << /Type /Page -/Contents 1366 0 R -/Resources 1364 0 R +/Contents 1391 0 R +/Resources 1389 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1363 0 R +/Parent 1378 0 R >> endobj -1367 0 obj << -/D [1365 0 R /XYZ 150.705 740.998 null] +1392 0 obj << +/D [1390 0 R /XYZ 150.705 740.998 null] >> endobj -390 0 obj << -/D [1365 0 R /XYZ 150.705 685.747 null] +398 0 obj << +/D [1390 0 R /XYZ 150.705 685.747 null] >> endobj -1364 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F27 433 0 R /F8 434 0 R >> +1389 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F27 441 0 R /F8 442 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1371 0 obj << +1396 0 obj << /Length 3710 >> stream @@ -16061,37 +16286,37 @@ BT 0 g 0 G /F8 9.9626 Tf 22.589 0 Td [(Error)-333(co)-28(de.)]TJ 2.318 -11.956 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf -29.611 -11.955 Td [(An)-333(in)28(tege)-1(r)-333(v)56(alue;)-334(0)-333(means)-333(no)-334(error)-333(has)-333(b)-28(een)-333(detected.)]TJ 0 g 0 G - 139.477 -264.549 Td [(117)]TJ + 139.477 -264.549 Td [(119)]TJ 0 g 0 G ET endstream endobj -1370 0 obj << +1395 0 obj << /Type /Page -/Contents 1371 0 R -/Resources 1369 0 R +/Contents 1396 0 R +/Resources 1394 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1363 0 R -/Annots [ 1368 0 R ] +/Parent 1378 0 R +/Annots [ 1393 0 R ] >> endobj -1368 0 obj << +1393 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [294.721 584.903 367.009 596.028] /Subtype /Link /A << /S /GoTo /D (spdata) >> >> endobj -1372 0 obj << -/D [1370 0 R /XYZ 99.895 740.998 null] +1397 0 obj << +/D [1395 0 R /XYZ 99.895 740.998 null] >> endobj -394 0 obj << -/D [1370 0 R /XYZ 99.895 685.747 null] +402 0 obj << +/D [1395 0 R /XYZ 99.895 685.747 null] >> endobj -1369 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F27 433 0 R /F8 434 0 R >> +1394 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F27 441 0 R /F8 442 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1375 0 obj << +1400 0 obj << /Length 912 >> stream @@ -16108,29 +16333,29 @@ BT 0 g 0 G /F8 9.9626 Tf 9.962 0 Td [(Blo)-28(c)28(k)-333(Jacobi)-334(with)-333(ILU\0500\051)-333(factorization)]TJ -24.906 -19.925 Td [(The)-364(supp)-27(orting)-364(data)-363(t)27(yp)-27(e)-364(and)-364(subroutin)1(e)-364(in)28(terfaces)-364(are)-364(de\014ned)-363(in)-364(the)-363(mo)-28(dule)]TJ/F30 9.9626 Tf 0 -11.955 Td [(psb_prec_mod)]TJ/F8 9.9626 Tf 62.764 0 Td [(.)]TJ 0 g 0 G - 101.619 -510.184 Td [(118)]TJ + 101.619 -510.184 Td [(120)]TJ 0 g 0 G ET endstream endobj -1374 0 obj << +1399 0 obj << /Type /Page -/Contents 1375 0 R -/Resources 1373 0 R +/Contents 1400 0 R +/Resources 1398 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1363 0 R +/Parent 1378 0 R >> endobj -1376 0 obj << -/D [1374 0 R /XYZ 150.705 740.998 null] +1401 0 obj << +/D [1399 0 R /XYZ 150.705 740.998 null] >> endobj -398 0 obj << -/D [1374 0 R /XYZ 150.705 716.092 null] +406 0 obj << +/D [1399 0 R /XYZ 150.705 716.092 null] >> endobj -1373 0 obj << -/Font << /F16 431 0 R /F8 434 0 R /F14 604 0 R /F30 601 0 R >> +1398 0 obj << +/Font << /F16 439 0 R /F8 442 0 R /F14 614 0 R /F30 611 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1381 0 obj << +1406 0 obj << /Length 4642 >> stream @@ -16214,47 +16439,47 @@ BT /F32 5.9776 Tf 110.987 123.138 Td [(3)]TJ/F31 7.9701 Tf 4.151 -2.812 Td [(The)-354(string)-354(is)-355(case-insensitiv)30(e)]TJ 0 g 0 G 0 g 0 G -/F8 9.9626 Tf 149.141 -29.888 Td [(119)]TJ +/F8 9.9626 Tf 149.141 -29.888 Td [(121)]TJ 0 g 0 G ET endstream endobj -1380 0 obj << +1405 0 obj << /Type /Page -/Contents 1381 0 R -/Resources 1379 0 R +/Contents 1406 0 R +/Resources 1404 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1363 0 R -/Annots [ 1377 0 R 1378 0 R ] +/Parent 1409 0 R +/Annots [ 1402 0 R 1403 0 R ] >> endobj -1377 0 obj << +1402 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [321.343 511.179 388.401 522.304] /Subtype /Link /A << /S /GoTo /D (precdata) >> >> endobj -1378 0 obj << +1403 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [168.831 421.792 175.293 433.832] /Subtype /Link /A << /S /GoTo /D (Hfootnote.3) >> >> endobj -1382 0 obj << -/D [1380 0 R /XYZ 99.895 740.998 null] +1407 0 obj << +/D [1405 0 R /XYZ 99.895 740.998 null] >> endobj -402 0 obj << -/D [1380 0 R /XYZ 99.895 697.37 null] +410 0 obj << +/D [1405 0 R /XYZ 99.895 697.37 null] >> endobj -1383 0 obj << -/D [1380 0 R /XYZ 115.138 129.79 null] +1408 0 obj << +/D [1405 0 R /XYZ 115.138 129.79 null] >> endobj -1379 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F27 433 0 R /F8 434 0 R /F11 587 0 R /F7 602 0 R /F32 605 0 R /F31 607 0 R >> +1404 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F27 441 0 R /F8 442 0 R /F11 597 0 R /F7 612 0 R /F32 615 0 R /F31 617 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1390 0 obj << +1416 0 obj << /Length 4723 >> stream @@ -16380,58 +16605,58 @@ BT 0 g 0 G /F8 9.9626 Tf 23.758 0 Td [(Error)-333(co)-28(de.)]TJ 1.148 -11.956 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.612 0 Td [(required)]TJ/F8 9.9626 Tf -29.612 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(out)]TJ/F8 9.9626 Tf 16.549 0 Td [(.)]TJ -50.035 -11.955 Td [(An)-333(in)27(t)1(e)-1(ger)-333(v)56(alue;)-334(0)-333(means)-333(no)-334(error)-333(has)-333(b)-28(een)-333(detec)-1(ted.)]TJ 0 g 0 G - 139.477 -194.811 Td [(120)]TJ + 139.477 -194.811 Td [(122)]TJ 0 g 0 G ET endstream endobj -1389 0 obj << +1415 0 obj << /Type /Page -/Contents 1390 0 R -/Resources 1388 0 R +/Contents 1416 0 R +/Resources 1414 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1363 0 R -/Annots [ 1384 0 R 1385 0 R 1386 0 R 1387 0 R ] +/Parent 1409 0 R +/Annots [ 1410 0 R 1411 0 R 1412 0 R 1413 0 R ] >> endobj -1384 0 obj << +1410 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [368.666 586.895 440.954 598.02] /Subtype /Link /A << /S /GoTo /D (spdata) >> >> endobj -1385 0 obj << +1411 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [447.73 519.15 514.788 530.274] /Subtype /Link /A << /S /GoTo /D (precdata) >> >> endobj -1386 0 obj << +1412 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [422.298 451.404 489.356 462.529] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -1387 0 obj << +1413 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [369.385 361.74 436.443 372.865] /Subtype /Link /A << /S /GoTo /D (precdata) >> >> endobj -1391 0 obj << -/D [1389 0 R /XYZ 150.705 740.998 null] +1417 0 obj << +/D [1415 0 R /XYZ 150.705 740.998 null] >> endobj -406 0 obj << -/D [1389 0 R /XYZ 150.705 697.37 null] +414 0 obj << +/D [1415 0 R /XYZ 150.705 697.37 null] >> endobj -1388 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F27 433 0 R /F8 434 0 R >> +1414 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F27 441 0 R /F8 442 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1396 0 obj << +1422 0 obj << /Length 5001 >> stream @@ -16531,44 +16756,44 @@ BT 0 g 0 G /F8 9.9626 Tf 23.758 0 Td [(Error)-333(co)-28(de.)]TJ 1.149 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf -29.611 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(out)]TJ/F8 9.9626 Tf 16.549 0 Td [(.)]TJ -50.035 -11.955 Td [(An)-333(in)28(tege)-1(r)-333(v)56(alue;)-334(0)-333(means)-333(no)-334(error)-333(has)-333(b)-28(een)-333(detecte)-1(d)1(.)]TJ 0 g 0 G - 139.477 -119.095 Td [(121)]TJ + 139.477 -119.095 Td [(123)]TJ 0 g 0 G ET endstream endobj -1395 0 obj << +1421 0 obj << /Type /Page -/Contents 1396 0 R -/Resources 1394 0 R +/Contents 1422 0 R +/Resources 1420 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1398 0 R -/Annots [ 1392 0 R 1393 0 R ] +/Parent 1409 0 R +/Annots [ 1418 0 R 1419 0 R ] >> endobj -1392 0 obj << +1418 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [321.343 574.94 388.401 586.065] /Subtype /Link /A << /S /GoTo /D (precdata) >> >> endobj -1393 0 obj << +1419 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [324.885 463.359 391.943 474.484] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -1397 0 obj << -/D [1395 0 R /XYZ 99.895 740.998 null] +1423 0 obj << +/D [1421 0 R /XYZ 99.895 740.998 null] >> endobj -410 0 obj << -/D [1395 0 R /XYZ 99.895 697.37 null] +418 0 obj << +/D [1421 0 R /XYZ 99.895 697.37 null] >> endobj -1394 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F27 433 0 R /F8 434 0 R >> +1420 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F27 441 0 R /F8 442 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1402 0 obj << +1427 0 obj << /Length 1996 >> stream @@ -16620,37 +16845,37 @@ BT 0 g 0 G /F8 9.9626 Tf 24.713 0 Td [(output)-333(unit.)-444(Scop)-28(e:)]TJ/F27 9.9626 Tf 89.94 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -89.747 -11.956 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.612 0 Td [(optiona)]TJ/F8 9.9626 Tf -29.612 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(in)]TJ/F8 9.9626 Tf 9.548 0 Td [(.)]TJ -43.034 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-445(an)-333(in)28(teger)-333(n)27(um)28(b)-28(er.)]TJ 0 g 0 G - 139.477 -417.974 Td [(122)]TJ + 139.477 -417.974 Td [(124)]TJ 0 g 0 G ET endstream endobj -1401 0 obj << +1426 0 obj << /Type /Page -/Contents 1402 0 R -/Resources 1400 0 R +/Contents 1427 0 R +/Resources 1425 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1398 0 R -/Annots [ 1399 0 R ] +/Parent 1409 0 R +/Annots [ 1424 0 R ] >> endobj -1399 0 obj << +1424 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [372.153 560.993 439.211 572.118] /Subtype /Link /A << /S /GoTo /D (precdata) >> >> endobj -1403 0 obj << -/D [1401 0 R /XYZ 150.705 740.998 null] +1428 0 obj << +/D [1426 0 R /XYZ 150.705 740.998 null] >> endobj -414 0 obj << -/D [1401 0 R /XYZ 150.705 685.747 null] +422 0 obj << +/D [1426 0 R /XYZ 150.705 685.747 null] >> endobj -1400 0 obj << -/Font << /F16 431 0 R /F30 601 0 R /F27 433 0 R /F8 434 0 R >> +1425 0 obj << +/Font << /F16 439 0 R /F30 611 0 R /F27 441 0 R /F8 442 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1406 0 obj << +1431 0 obj << /Length 598 >> stream @@ -16659,29 +16884,29 @@ stream BT /F16 14.3462 Tf 99.895 706.129 Td [(11)-1125(Iterativ)31(e)-375(Metho)-31(ds)]TJ/F8 9.9626 Tf 0 -21.821 Td [(In)-519(this)-518(c)28(hapter)-519(w)28(e)-519(pro)28(vide)-519(routin)1(e)-1(s)-518(for)-519(preconditioners)-518(and)-519(iterativ)28(e)-519(meth-)]TJ 0 -11.955 Td [(o)-28(ds.)-647(The)-401(in)28(terfaces)-401(for)-401(Kryl)1(o)27(v)-401(subspace)-400(m)-1(etho)-27(ds)-401(are)-401(a)28(v)55(ailable)-400(in)-401(the)-401(mo)-28(dule)]TJ/F30 9.9626 Tf 0 -11.955 Td [(psb_krylov_mod)]TJ/F8 9.9626 Tf 73.225 0 Td [(.)]TJ 0 g 0 G - 91.159 -569.96 Td [(123)]TJ + 91.159 -569.96 Td [(125)]TJ 0 g 0 G ET endstream endobj -1405 0 obj << +1430 0 obj << /Type /Page -/Contents 1406 0 R -/Resources 1404 0 R +/Contents 1431 0 R +/Resources 1429 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1398 0 R +/Parent 1409 0 R >> endobj -1407 0 obj << -/D [1405 0 R /XYZ 99.895 740.998 null] +1432 0 obj << +/D [1430 0 R /XYZ 99.895 740.998 null] >> endobj -418 0 obj << -/D [1405 0 R /XYZ 99.895 716.092 null] +426 0 obj << +/D [1430 0 R /XYZ 99.895 716.092 null] >> endobj -1404 0 obj << -/Font << /F16 431 0 R /F8 434 0 R /F30 601 0 R >> +1429 0 obj << +/Font << /F16 439 0 R /F8 442 0 R /F30 611 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1412 0 obj << +1437 0 obj << /Length 7212 >> stream @@ -16797,44 +17022,44 @@ BT 0 g 0 G /F8 9.9626 Tf 11.346 0 Td [(The)-333(RHS)-334(v)28(ector.)]TJ 13.56 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.612 0 Td [(required)]TJ/F8 9.9626 Tf -29.612 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(in)]TJ/F8 9.9626 Tf 9.548 0 Td [(.)]TJ -43.034 -11.955 Td [(Sp)-28(eci\014ed)-333(as:)-445(a)-333(rank)-333(one)-334(ar)1(ra)27(y)84(.)]TJ 0 g 0 G - 139.477 -29.888 Td [(124)]TJ + 139.477 -29.888 Td [(126)]TJ 0 g 0 G ET endstream endobj -1411 0 obj << +1436 0 obj << /Type /Page -/Contents 1412 0 R -/Resources 1410 0 R +/Contents 1437 0 R +/Resources 1435 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1398 0 R -/Annots [ 1408 0 R 1409 0 R ] +/Parent 1409 0 R +/Annots [ 1433 0 R 1434 0 R ] >> endobj -1408 0 obj << +1433 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [345.53 250.914 417.818 262.039] /Subtype /Link /A << /S /GoTo /D (spdata) >> >> endobj -1409 0 obj << +1434 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [345.53 184.015 412.588 195.14] /Subtype /Link /A << /S /GoTo /D (precdata) >> >> endobj -1413 0 obj << -/D [1411 0 R /XYZ 150.705 740.998 null] +1438 0 obj << +/D [1436 0 R /XYZ 150.705 740.998 null] >> endobj -422 0 obj << -/D [1411 0 R /XYZ 150.705 697.37 null] +430 0 obj << +/D [1436 0 R /XYZ 150.705 697.37 null] >> endobj -1410 0 obj << -/Font << /F16 431 0 R /F8 434 0 R /F11 587 0 R /F14 604 0 R /F10 603 0 R /F7 602 0 R /F30 601 0 R /F27 433 0 R >> +1435 0 obj << +/Font << /F16 439 0 R /F8 442 0 R /F11 597 0 R /F14 614 0 R /F10 613 0 R /F7 612 0 R /F30 611 0 R /F27 441 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1417 0 obj << +1442 0 obj << /Length 5689 >> stream @@ -16902,34 +17127,34 @@ BT 0 g 0 G /F8 9.9626 Tf 11.028 0 Td [(The)-333(computed)-334(solution.)]TJ 13.879 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.955 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.611 0 Td [(required)]TJ/F8 9.9626 Tf -29.611 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(inout)]TJ/F8 9.9626 Tf 26.096 0 Td [(.)]TJ -59.582 -11.956 Td [(Sp)-28(eci\014ed)-333(as:)-445(a)-333(rank)-333(one)-333(arra)27(y)84(.)]TJ 0 g 0 G - 139.477 -29.887 Td [(125)]TJ + 139.477 -29.887 Td [(127)]TJ 0 g 0 G ET endstream endobj -1416 0 obj << +1441 0 obj << /Type /Page -/Contents 1417 0 R -/Resources 1415 0 R +/Contents 1442 0 R +/Resources 1440 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1398 0 R -/Annots [ 1414 0 R ] +/Parent 1444 0 R +/Annots [ 1439 0 R ] >> endobj -1414 0 obj << +1439 0 obj << /Type /Annot /Border[0 0 0]/H/I/C[1 0 0] /Rect [294.721 520.602 361.779 531.727] /Subtype /Link /A << /S /GoTo /D (descdata) >> >> endobj -1418 0 obj << -/D [1416 0 R /XYZ 99.895 740.998 null] +1443 0 obj << +/D [1441 0 R /XYZ 99.895 740.998 null] >> endobj -1415 0 obj << -/Font << /F27 433 0 R /F8 434 0 R /F30 601 0 R /F11 587 0 R /F14 604 0 R >> +1440 0 obj << +/Font << /F27 441 0 R /F8 442 0 R /F30 611 0 R /F11 597 0 R /F14 614 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1421 0 obj << +1447 0 obj << /Length 2484 >> stream @@ -16953,26 +17178,26 @@ BT 0 g 0 G /F8 9.9626 Tf 23.758 0 Td [(Error)-333(co)-28(de.)]TJ 1.148 -11.955 Td [(Scop)-28(e:)]TJ/F27 9.9626 Tf 32.379 0 Td [(lo)-32(cal)]TJ/F8 9.9626 Tf -32.379 -11.956 Td [(T)28(yp)-28(e:)]TJ/F27 9.9626 Tf 29.612 0 Td [(required)]TJ/F8 9.9626 Tf -29.612 -11.955 Td [(In)28(ten)28(t:)]TJ/F27 9.9626 Tf 33.486 0 Td [(out)]TJ/F8 9.9626 Tf 16.549 0 Td [(.)]TJ -50.035 -11.955 Td [(An)-333(in)28(te)-1(ger)-333(v)56(alue;)-334(0)-333(means)-333(no)-334(error)-333(has)-333(b)-28(een)-333(detec)-1(ted.)]TJ 0 g 0 G - 139.477 -352.677 Td [(126)]TJ + 139.477 -352.677 Td [(128)]TJ 0 g 0 G ET endstream endobj -1420 0 obj << +1446 0 obj << /Type /Page -/Contents 1421 0 R -/Resources 1419 0 R +/Contents 1447 0 R +/Resources 1445 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1398 0 R +/Parent 1444 0 R >> endobj -1422 0 obj << -/D [1420 0 R /XYZ 150.705 740.998 null] +1448 0 obj << +/D [1446 0 R /XYZ 150.705 740.998 null] >> endobj -1419 0 obj << -/Font << /F27 433 0 R /F8 434 0 R /F11 587 0 R >> +1445 0 obj << +/Font << /F27 441 0 R /F8 442 0 R /F11 597 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1425 0 obj << +1451 0 obj << /Length 6932 >> stream @@ -17029,65 +17254,65 @@ BT 0 g 0 G [-500(La)28(wson,)-339(C.,)-339(Hanson,)-339(R.,)-339(Kincaid,)-339(D.)-338(and)-338(Krogh,)-339(F.,)-339(Basic)-338(Linear)-338(Algebra)]TJ 20.479 -11.955 Td [(Subprograms)-337(for)-336(Fortran)-337(usage,)-338(A)28(CM)-337(T)84(rans.)-337(Math.)-337(Soft)28(w.)-337(v)28(ol.)-337(5,)-337(38{329,)]TJ 0 -11.955 Td [(1979.)]TJ 0 g 0 G - 143.905 -29.888 Td [(127)]TJ + 143.905 -29.888 Td [(129)]TJ 0 g 0 G ET endstream endobj -1424 0 obj << +1450 0 obj << /Type /Page -/Contents 1425 0 R -/Resources 1423 0 R +/Contents 1451 0 R +/Resources 1449 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1431 0 R +/Parent 1444 0 R >> endobj -1426 0 obj << -/D [1424 0 R /XYZ 99.895 740.998 null] +1452 0 obj << +/D [1450 0 R /XYZ 99.895 740.998 null] >> endobj -1427 0 obj << -/D [1424 0 R /XYZ 99.895 696.263 null] +1453 0 obj << +/D [1450 0 R /XYZ 99.895 696.263 null] >> endobj -1428 0 obj << -/D [1424 0 R /XYZ 99.895 699.619 null] +1454 0 obj << +/D [1450 0 R /XYZ 99.895 699.619 null] >> endobj -623 0 obj << -/D [1424 0 R /XYZ 99.895 643.15 null] +633 0 obj << +/D [1450 0 R /XYZ 99.895 643.15 null] >> endobj -622 0 obj << -/D [1424 0 R /XYZ 99.895 588.618 null] +632 0 obj << +/D [1450 0 R /XYZ 99.895 588.618 null] >> endobj -580 0 obj << -/D [1424 0 R /XYZ 99.895 534.087 null] +590 0 obj << +/D [1450 0 R /XYZ 99.895 534.087 null] >> endobj -581 0 obj << -/D [1424 0 R /XYZ 99.895 491.51 null] +591 0 obj << +/D [1450 0 R /XYZ 99.895 491.51 null] >> endobj -593 0 obj << -/D [1424 0 R /XYZ 99.895 448.934 null] +603 0 obj << +/D [1450 0 R /XYZ 99.895 448.934 null] >> endobj -577 0 obj << -/D [1424 0 R /XYZ 99.895 405.804 null] +587 0 obj << +/D [1450 0 R /XYZ 99.895 405.804 null] >> endobj -578 0 obj << -/D [1424 0 R /XYZ 99.895 363.227 null] +588 0 obj << +/D [1450 0 R /XYZ 99.895 363.227 null] >> endobj -1429 0 obj << -/D [1424 0 R /XYZ 99.895 320.651 null] +1455 0 obj << +/D [1450 0 R /XYZ 99.895 320.651 null] >> endobj -1430 0 obj << -/D [1424 0 R /XYZ 99.895 278.074 null] +1456 0 obj << +/D [1450 0 R /XYZ 99.895 278.074 null] >> endobj -609 0 obj << -/D [1424 0 R /XYZ 99.895 214.078 null] +619 0 obj << +/D [1450 0 R /XYZ 99.895 214.078 null] >> endobj -579 0 obj << -/D [1424 0 R /XYZ 99.895 157.333 null] +589 0 obj << +/D [1450 0 R /XYZ 99.895 157.333 null] >> endobj -1423 0 obj << -/Font << /F16 431 0 R /F8 434 0 R /F17 573 0 R /F30 601 0 R >> +1449 0 obj << +/Font << /F16 439 0 R /F8 442 0 R /F17 583 0 R /F30 611 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1434 0 obj << +1459 0 obj << /Length 1404 >> stream @@ -17107,83 +17332,83 @@ BT 0 g 0 G [-500(M.)-443(Snir,)-471(S.)-443(Otto,)-471(S.)-443(Huss-Lederman,)-471(D.)-443(W)84(alk)27(er)-443(and)-443(J.)-443(Dongarra,)]TJ/F17 9.9626 Tf 321.124 0 Td [(MPI:)]TJ -300.645 -11.955 Td [(The)-365(Complete)-365(R)51(efer)51(enc)51(e.)-365(V)76(ol)1(ume)-366(1)-365(-)-365(The)-365(MPI)-365(Cor)51(e)]TJ/F8 9.9626 Tf 228.803 0 Td [(,)-343(sec)-1(on)1(d)-342(edition,)-343(MIT)]TJ -228.803 -11.956 Td [(Press,)-333(1998.)]TJ 0 g 0 G - 143.904 -516.064 Td [(128)]TJ + 143.904 -516.064 Td [(130)]TJ 0 g 0 G ET endstream endobj -1433 0 obj << +1458 0 obj << /Type /Page -/Contents 1434 0 R -/Resources 1432 0 R +/Contents 1459 0 R +/Resources 1457 0 R /MediaBox [0 0 595.276 841.89] -/Parent 1431 0 R +/Parent 1444 0 R >> endobj -1435 0 obj << -/D [1433 0 R /XYZ 150.705 740.998 null] +1460 0 obj << +/D [1458 0 R /XYZ 150.705 740.998 null] >> endobj -576 0 obj << -/D [1433 0 R /XYZ 150.705 716.092 null] +586 0 obj << +/D [1458 0 R /XYZ 150.705 716.092 null] >> endobj -575 0 obj << -/D [1433 0 R /XYZ 150.705 676.296 null] +585 0 obj << +/D [1458 0 R /XYZ 150.705 676.296 null] >> endobj -1436 0 obj << -/D [1433 0 R /XYZ 150.705 644.416 null] +1461 0 obj << +/D [1458 0 R /XYZ 150.705 644.416 null] >> endobj -1432 0 obj << -/Font << /F8 434 0 R /F17 573 0 R >> +1457 0 obj << +/Font << /F8 442 0 R /F17 583 0 R >> /ProcSet [ /PDF /Text ] >> endobj -1437 0 obj +1462 0 obj [399.7 399.7 513.9 799.4 285.5 342.6 285.5 513.9 513.9 513.9 513.9 513.9 513.9 513.9 513.9 513.9 513.9 513.9 285.5 285.5 285.5 799.4 485.3 485.3 799.4 770.7 727.9 742.3 785 699.4 670.8 806.5 770.7 371 528.1 799.2 642.3 942 770.7 799.4 699.4 799.4 756.5 571 742.3 770.7 770.7 1056.2 770.7 770.7 628.1 285.5 513.9 285.5 513.9 285.5 285.5 513.9 571 456.8 571 457.2 314 513.9 571 285.5 314 542.4 285.5 856.5 571 513.9 571 542.4 402 405.4] endobj -1438 0 obj +1463 0 obj [892.9 339.3 892.9 585.3 892.9 585.3 892.9 892.9 892.9 892.9 892.9 892.9 892.9 1138.9 585.3 585.3 892.9 892.9 892.9 892.9 892.9 892.9 892.9 892.9 892.9 892.9 892.9 892.9 1138.9 1138.9 892.9 892.9 1138.9 1138.9 585.3 585.3 1138.9 1138.9 1138.9 892.9 1138.9 1138.9 708.3 708.3 1138.9 1138.9 1138.9 892.9 329.4 1138.9] endobj -1439 0 obj +1464 0 obj [525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525] endobj -1440 0 obj +1465 0 obj [533.6] endobj -1441 0 obj +1466 0 obj [413.2 413.2 531.3 826.4 295.1 354.2 295.1 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 531.3 295.1 295.1 295.1 826.4 501.7 501.7 826.4 795.8 752.1 767.4 811.1 722.6 693.1 833.5 795.8 382.6 545.5 825.4 663.6 972.9 795.8 826.4 722.6 826.4 781.6 590.3 767.4 795.8 795.8 1091 795.8 795.8 649.3 295.1 531.3 295.1 531.3 295.1 295.1 531.3 590.3 472.2 590.3 472.2 324.7 531.3 590.3 295.1 324.7 560.8 295.1 885.4 590.3 531.3 590.3 560.8 414.1 419.1 413.2 590.3 560.8 767.4 560.8 560.8] endobj -1442 0 obj +1467 0 obj [611.1 611.1 611.1] endobj -1443 0 obj +1468 0 obj [777.8 277.8 777.8 500 777.8 500 777.8 777.8 777.8 777.8 777.8 777.8 777.8 1000 500 500 777.8 777.8 777.8 777.8 777.8 777.8 777.8 777.8 777.8 777.8 777.8 777.8 1000 1000 777.8 777.8 1000 1000 500 500 1000 1000 1000 777.8 1000 1000 611.1 611.1 1000 1000 1000 777.8 275 1000 666.7 666.7 888.9 888.9 0 0 555.6 555.6 666.7 500 722.2 722.2 777.8 777.8 611.1 798.5 656.8 526.5 771.4 527.8 718.7 594.9 844.5 544.5 677.8 762 689.7 1200.9 820.5 796.1 695.6 816.7 847.5 605.6 544.6 625.8 612.8 987.8 713.3 668.3 724.7 666.7 666.7 666.7 666.7 666.7 611.1 611.1 444.4 444.4 444.4 444.4 500 500 388.9 388.9 277.8 500 500 611.1 500 277.8 833.3 750 833.3 416.7 666.7 666.7 777.8 777.8 444.4] endobj -1444 0 obj +1469 0 obj [339.3 892.9 585.3 892.9 585.3 610.1 859.1 863.2 819.4 934.1 838.7 724.5 889.4 935.6 506.3 632 959.9 783.7 1089.4 904.9 868.9 727.3 899.7 860.6 701.5 674.8 778.2 674.6 1074.4 936.9 671.5 778.4 462.3 462.3 462.3 1138.9 1138.9 478.2 619.7 502.4 510.5 594.7 542 557.1 557.3 668.8 404.2 472.7 607.3 361.3 1013.7 706.2 563.9 588.9 523.6 530.4] endobj -1445 0 obj +1470 0 obj [569.5 569.5 569.5 569.5 569.5 569.5 569.5 569.5 569.5 323.4] endobj -1446 0 obj -[525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525] +1471 0 obj +[525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525] endobj -1447 0 obj +1472 0 obj [639.7 565.6 517.7 444.4 405.9 437.5 496.5 469.4 353.9 576.2 583.3 602.6 494 437.5 570 517 571.4 437.2 540.3 595.8 625.7 651.4 622.5 466.3 591.4 828.1 517 362.8 654.2 1000 1000 1000 1000 277.8 277.8 500 500 500 500 500 500 500 500 500 500 500 500 277.8 277.8 777.8 500 777.8 500 530.9 750 758.5 714.7 827.9 738.2 643.1 786.3 831.3 439.6 554.5 849.3 680.6 970.1 803.5 762.8 642 790.6 759.3 613.2 584.4 682.8 583.3 944.4 828.5 580.6 682.6 388.9 388.9 388.9 1000 1000 416.7 528.6 429.2 432.8 520.5 465.6 489.6 477 576.2 344.5 411.8 520.6 298.4 878 600.2 484.7 503.1 446.4 451.2 468.8 361.1 572.5 484.7 715.9 571.5 490.3 465.1] endobj -1448 0 obj +1473 0 obj [613.3 562.2 587.8 881.7 894.4 306.7 332.2 511.1 511.1 511.1 511.1 511.1 831.3 460 536.7 715.6 715.6 511.1 882.8 985 766.7 255.6 306.7 514.4 817.8 769.1 817.8 766.7 306.7 408.9 408.9 511.1 766.7 306.7 357.8 306.7 511.1 511.1 511.1 511.1 511.1 511.1 511.1 511.1 511.1 511.1 511.1 306.7 306.7 306.7 766.7 511.1 511.1 766.7 743.3 703.9 715.6 755 678.3 652.8 773.6 743.3 385.6 525 768.9 627.2 896.7 743.3 766.7 678.3 766.7 729.4 562.2 715.6 743.3 743.3 998.9 743.3 743.3 613.3 306.7 514.4 306.7 511.1 306.7 306.7 511.1 460 460 511.1 460 306.7 460 511.1 306.7 306.7 460 255.6 817.8 562.2 511.1 511.1 460 421.7 408.9 332.2 536.7 460 664.4 463.9 485.6] endobj -1449 0 obj +1474 0 obj [583.3 555.6 555.6 833.3 833.3 277.8 305.6 500 500 500 500 500 750 444.4 500 722.2 777.8 500 902.8 1013.9 777.8 277.8 277.8 500 833.3 500 833.3 777.8 277.8 388.9 388.9 500 777.8 277.8 333.3 277.8 500 500 500 500 500 500 500 500 500 500 500 277.8 277.8 277.8 777.8 472.2 472.2 777.8 750 708.3 722.2 763.9 680.6 652.8 784.7 750 361.1 513.9 777.8 625 916.7 750 777.8 680.6 777.8 736.1 555.6 722.2 750 750 1027.8 750 750 611.1 277.8 500 277.8 500 277.8 277.8 500 555.6 444.4 555.6 444.4 305.6 500 555.6 277.8 305.6 527.8 277.8 833.3 555.6 500 555.6 527.8 391.7 394.4 388.9 555.6 527.8 722.2 527.8 527.8 444.4 500] endobj -1450 0 obj +1475 0 obj [638.9 638.9 958.3 958.3 319.4 351.4 575 575 575 575 575 869.4 511.1 597.2 830.6 894.4 575 1041.7 1169.4 894.4 319.4 350 602.8 958.3 575 958.3 894.4 319.4 447.2 447.2 575 894.4 319.4 383.3 319.4 575 575 575 575 575 575 575 575 575 575 575 319.4 319.4 350 894.4 543.1 543.1 894.4 869.4 818.1 830.6 881.9 755.6 723.6 904.2 900 436.1 594.4 901.4 691.7 1091.7 900 863.9 786.1 863.9 862.5 638.9 800 884.7 869.4 1188.9 869.4 869.4 702.8 319.4 602.8 319.4 575 319.4 319.4 559 638.9 511.1 638.9 527.1 351.4 575 638.9 319.4 351.4 606.9 319.4 958.3 638.9 575 638.9 606.9 473.6 453.6 447.2 638.9 606.9 830.6 606.9 606.9 511.1 575 1150] endobj -1451 0 obj +1476 0 obj [726.9 688.4 700 738.4 663.4 638.4 756.7 726.9 376.9 513.4 751.9 613.4 876.9 726.9 750 663.4 750 713.4 550 700 726.9 726.9 976.9 726.9 726.9 600 300 500 300 500 300 300 500 450 450 500 450 300 450 500 300 300 450 250 800 550 500 500 450 412.5 400 325 525 450 650 450 475] endobj -1452 0 obj +1477 0 obj [625 625 937.5 937.5 312.5 343.7 562.5 562.5 562.5 562.5 562.5 849.5 500 574.1 812.5 875 562.5 1018.5 1143.5 875 312.5 342.6 581 937.5 562.5 937.5 875 312.5 437.5 437.5 562.5 875 312.5 375 312.5 562.5 562.5 562.5 562.5 562.5 562.5 562.5 562.5 562.5 562.5 562.5 312.5 312.5 342.6 875 531.2 531.2 875 849.5 799.8 812.5 862.3 738.4 707.2 884.3 879.6 419 581 880.8 675.9 1067.1 879.6 844.9 768.5 844.9 839.1 625 782.4 864.6 849.5 1162 849.5 849.5 687.5 312.5 581 312.5 562.5 312.5 312.5 546.9 625 500 625 513.3 343.7 562.5 625 312.5 343.7 593.7 312.5 937.5 625 562.5 625 593.7 459.5 443.8 437.5 625 593.7 812.5 593.7 593.7 500 562.5 1125] endobj -1453 0 obj << +1478 0 obj << /Length1 1782 /Length2 12254 /Length3 0 @@ -17343,7 +17568,7 @@ a Ï�²ÏØÔrÒð†¼“Ò,óîõSû'ÐDz)…ìSªÞ!x�°¯°£ÊœõÁ�íÿåq8DËå´ËQ¦ƒiåáÈ>öŒéš�?é§™+™ã�«lÊÝmª�Jðoôù}܃¹Œb6 endstream endobj -1454 0 obj << +1479 0 obj << /Type /FontDescriptor /FontName /GPIGCD+CMBX10 /Flags 4 @@ -17355,9 +17580,9 @@ endobj /StemV 114 /XHeight 444 /CharSet (/A/B/C/D/E/F/G/H/I/J/L/M/N/O/P/R/S/T/U/V/a/b/c/colon/comma/d/e/eight/emdash/endash/equal/f/fi/five/fl/four/g/h/i/j/k/l/m/n/nine/o/one/p/period/q/quotedblleft/quotedblright/quoteright/r/s/seven/six/t/three/two/u/v/w/x/y/z/zero) -/FontFile 1453 0 R +/FontFile 1478 0 R >> endobj -1455 0 obj << +1480 0 obj << /Length1 1734 /Length2 10564 /Length3 0 @@ -17487,7 +17712,7 @@ BO �­Œ$*Jü1õ‘J{Y^>y†ˆKÃ=�ÿ�b>'¿M¾9Ì|6ðÊN¤ã®ýµì%ÍíWœýÀSù�5´öL6Œ_<ûTgÊM3€ìuÆÍ,€\\�Co #Ž§Ñ£Gû&òä!=D×*…0DWÙÇÙÏ)@4[ÃZIz1°‹Ö˜y©‹ÄþeRaµi=˜£( Ÿ~7aÙ„¬Üæ<¢ÞÓfë@ÇJ†,˜ì^3Ç«\`D•¦€Úþ²-@ÎÒ‡)e]R³•YÖË&–½Ð�ÞIÆŒ½OW,aëh俯Ԯb:â�ôºá÷b€ðHU65uC�(½"ÂmÙKxz·˜²›èMtì¯xpÙ§èlª‘¹\€7”S9žcЬju�ðÀXlØ\‰|�f6ƒxD�6�WYèKr±c]ûŒþ‘)êò Ž÷@Ojñß?цnšiªûJÑ:ˆ{{ž5{b° endstream endobj -1456 0 obj << +1481 0 obj << /Type /FontDescriptor /FontName /GBHFLB+CMBX12 /Flags 4 @@ -17499,9 +17724,9 @@ endobj /StemV 109 /XHeight 444 /CharSet (/A/B/C/D/E/F/G/H/I/K/L/M/N/O/P/Q/R/S/T/U/V/W/a/b/c/d/e/eight/emdash/endash/f/fi/five/four/g/h/hyphen/i/k/l/m/n/nine/o/one/p/parenleft/parenright/period/q/quoteright/r/s/seven/six/t/three/two/u/v/w/x/y/z/zero) -/FontFile 1455 0 R +/FontFile 1480 0 R >> endobj -1457 0 obj << +1482 0 obj << /Length1 1397 /Length2 9610 /Length3 0 @@ -17608,7 +17833,7 @@ gR ~Š š¹Çüž±×\xÑò<Êýo’[-¯$›LÁ]0. óäájÍÃ0˜KF‚^ú[@] /ßÛÁs9,@�\ªf8š3(ŠöˆÊQ•œzQ{§X Ò– Œ{ý3GŽIñòSv»ëL…¬ ^«yR6P^1X��u3ÜBl}#›¶8¦®Gw-cd½üœö8™§´6˜‰!ã´Ýh²¶èÃòêãþ 4 ¶nÖßNu»[š�Ñc­#•{sTÈ\kð»~¤IÊ×®7-òOhW»¥ @Ò[Ê*$Pã7T1 endstream endobj -1458 0 obj << +1483 0 obj << /Type /FontDescriptor /FontName /XOPWSZ+CMMI10 /Flags 4 @@ -17620,9 +17845,9 @@ endobj /StemV 72 /XHeight 431 /CharSet (/A/C/D/G/I/L/N/O/P/Q/T/U/X/a/alpha/b/beta/c/comma/d/e/f/g/greater/h/i/j/k/l/less/m/n/o/p/period/r/s/t/u/v/w/x/y/z) -/FontFile 1457 0 R +/FontFile 1482 0 R >> endobj -1459 0 obj << +1484 0 obj << /Length1 745 /Length2 1242 /Length3 0 @@ -17660,7 +17885,7 @@ currentfile eexec ñPŠ?–�_ %œD3´)‚/Å‘ˆdL£sw(wÞ&Mʺ™E¿Ât æ7â8k¬aò;BF�åŸD¦(ÐéJø endstream endobj -1460 0 obj << +1485 0 obj << /Type /FontDescriptor /FontName /RVPZIX+CMMI5 /Flags 4 @@ -17672,9 +17897,9 @@ endobj /StemV 90 /XHeight 431 /CharSet (/i) -/FontFile 1459 0 R +/FontFile 1484 0 R >> endobj -1461 0 obj << +1486 0 obj << /Length1 907 /Length2 3553 /Length3 0 @@ -17733,7 +17958,7 @@ NØ• 7ñl‚Þµ`é–ùŸ«â¬\²Uñ‰ó·(:F'ñ½NÛ¿*Î,#Ã�|T»÷ëZN÷ò`Ί‚¾³lxer3«¼bÓ­{Íã©…Î$=ü„f}mi•é‘\i}H¶ibš{‚=£ª¬3l¹#/ΊŸŠ›0¾Pé>§ãò©­Ùú.Hg½‚`É\w�i³µ‚¿SNå„*¦1~œ^6#4Þ¯q[“( ÉDh”ªÈ^<ò(£À»“ÈSäEÛKÔÕ’|‚s²#qéýÑ€%Éü æ:`…Xz$RN#;Ùüm|˜Ï’°àòR•bÒ'n@¯]Z³cƒB£S7rÏéNÚ‡½óñá ÑóÙ2¸Ü\ˆ‰¤û endstream endobj -1462 0 obj << +1487 0 obj << /Type /FontDescriptor /FontName /LUIBYK+CMMI7 /Flags 4 @@ -17745,9 +17970,9 @@ endobj /StemV 81 /XHeight 431 /CharSet (/H/I/T/a/c/comma/i/j/k/m/n/r) -/FontFile 1461 0 R +/FontFile 1486 0 R >> endobj -1463 0 obj << +1488 0 obj << /Length1 2012 /Length2 14626 /Length3 0 @@ -17909,7 +18134,7 @@ j% |¥_!ÿ¶&[Ã8YO(öä9ÕºZH!ü’Ы\ìs\é’8Ãþå|Ô‚­|ÍMú\Ī Ëd€!õ~Œ [»´ã*=’QäeËg”8÷²ïë œ«¤Å#]·0ø•…’Jyr endstream endobj -1464 0 obj << +1489 0 obj << /Type /FontDescriptor /FontName /GHWWVJ+CMR10 /Flags 4 @@ -17921,9 +18146,9 @@ endobj /StemV 69 /XHeight 431 /CharSet (/A/B/C/D/E/F/G/H/I/J/K/L/M/N/O/P/R/S/T/U/V/W/a/ampersand/b/bracketleft/bracketright/c/colon/comma/d/e/eight/endash/equal/f/ff/ffi/fi/five/fl/four/g/h/hyphen/i/j/k/l/m/n/nine/o/one/p/parenleft/parenright/period/plus/q/quotedblleft/quotedblright/quoteright/r/s/semicolon/seven/six/slash/t/three/two/u/v/w/x/y/z/zero) -/FontFile 1463 0 R +/FontFile 1488 0 R >> endobj -1465 0 obj << +1490 0 obj << /Length1 769 /Length2 1408 /Length3 0 @@ -17965,7 +18190,7 @@ currentfile eexec µ)&ï�¹ó)/@^Ð⵸PY.¾ê—(�û½#´±SáRdíúmBq-‡_'ÈI-tñø‚¡ „/÷OþL»™Kô÷6§C€�w\³v#ܶ>ì"L‹“+†ò¿ÜÓüà•½”þa+‹YEoÎ endstream endobj -1466 0 obj << +1491 0 obj << /Type /FontDescriptor /FontName /YPSQTS+CMR6 /Flags 4 @@ -17977,9 +18202,9 @@ endobj /StemV 83 /XHeight 431 /CharSet (/one/three/two) -/FontFile 1465 0 R +/FontFile 1490 0 R >> endobj -1467 0 obj << +1492 0 obj << /Length1 787 /Length2 1497 /Length3 0 @@ -18023,7 +18248,7 @@ _2 ¡b›x}‰èË÷…¹Òºz’™­ºs7'þõ¸­)Æãõ8-X“ûTåG`û‡9?óPíe•úã“:– “^­‘3¶›‚~§ÍhécîxbkÜå1!o^ë�å™KÙWk«ìi7ݱ‚=3OÿÕá£ßø äô¼|ó endstream endobj -1468 0 obj << +1493 0 obj << /Type /FontDescriptor /FontName /EWABFK+CMR7 /Flags 4 @@ -18035,9 +18260,9 @@ endobj /StemV 79 /XHeight 431 /CharSet (/colon/one/three/two) -/FontFile 1467 0 R +/FontFile 1492 0 R >> endobj -1469 0 obj << +1494 0 obj << /Length1 1462 /Length2 8120 /Length3 0 @@ -18146,7 +18371,7 @@ j ë4×éùïwš�4“n½]{­ŽÂô§–sú,r/�Lˤ/ÝS.$Vܤ˜¶i¼+±WJvï¤‰Ž´*ö9Ã6\éu>£ÀtGÁ”Ûý¿Ò'3 (ªh[æ‚ð˜ÅWÿžu� º×:=»´bA¦‡àBæ¶ŒÂMÄða§Ýw’rº“ºÏÛ–¥,Ë¿OÝS2 ?3w·;§Â/nÊJ0Rã}CpÒSé^™:Ò¶Õzâê3Ì|8¦Võg¾Ã¡µ`Æ~ä17Æ[|~9dy_*z€UIJ@ö®{t”¤åØVKƒÒ;S¯ˆÿ±’m¤£¥‰Hçî³¼ –$úX`ÝWçª�ÂúôÔ>Œ—:þ8ùæ÷¿³ÁE4•¾Ÿ¼3� w¼>0—Mñoƒ›vºÒL–xy÷rbQ¡ƒUˆ0_tœ¹ºu™'Iá^mÇÉ]*äÉÊ—:¬Ý\ ÛÝxK»gD÷«Ù³Õ=I8­ŠºÒ�-œvx`%QÓ¢8ê™ÍE�ºïê+@eXnž"V¶¼ðæÅ"É�ƒe‚¿Sñ:®wS%d›9Ñž#Ä`ž˜íÔ’Õ²ˆð¬ËmûMBeäPnpbÜ“^mäï�bÅÃK0¾m1�÷R\&òÄe{b"ŒŒW{u“ˆ)W2x cšµ9�è¡|課#ᎹºJš¾ì—H1�ÒTÚ³v®n-F `¢Çî5*…¨¸G™1–¯}YûŠª¹ª•ÛÚωà?ñõ‚dUfÒ o.nÔIƒ”�fDg¬ðŒ/'@�Tîø|Ú>1ÐØø£éU.Byþ.‘�Ʀ¸25mª¹<Ês Ò—OËÇP œ®Ì÷·bM×v¬mšö¿ý²e…ö;ã{'½ì>Œ;×sáyâlµ’ØÀf9k Ƕz<È#�Ž ý¤ËSðž>"zµQµ’N<)W”°ni}À;žá½!“@æe¬Þâ± šÃW&è‚=ù»ä÷óFÝÎXËÙå²Í1.8.†ˆvi˜äƒ. &×S�Ó¬Ú74ÀÕRP¹ú´QC‹îNjÁ8Òq½ïàákYDå¢X4Ö±Htç7€ Azd5ZŒ†ã¿¾¹çÓ)05—ØN$HÑé�=R§K+‚²h`Pèù†T¿3Œ®'/(#ž+UŠ5¤A³Î-¢Œ��T endstream endobj -1470 0 obj << +1495 0 obj << /Type /FontDescriptor /FontName /TDRORS+CMR8 /Flags 4 @@ -18158,9 +18383,9 @@ endobj /StemV 76 /XHeight 431 /CharSet (/B/G/I/L/O/P/T/X/a/b/c/comma/d/e/eight/f/five/four/g/h/hyphen/i/l/m/n/nine/o/one/p/parenleft/parenright/period/q/r/s/seven/six/slash/t/three/two/u/v/w/x/y/zero) -/FontFile 1469 0 R +/FontFile 1494 0 R >> endobj -1471 0 obj << +1496 0 obj << /Length1 1125 /Length2 4765 /Length3 0 @@ -18249,7 +18474,7 @@ _ Ð*B¾ŠF™šcpB¬„©žò D…ÆýÄÃøÁ> endobj -1473 0 obj << +1498 0 obj << /Length1 1050 /Length2 2900 /Length3 0 @@ -18330,7 +18555,7 @@ R c’$”݈9`l¶�|‰2*2Nú´u4œýÕâô�v=¤rl³MÌp+§’…¶5ô†ÔÀµ‡™iu1Y@ãœ1[;îLE›êGÓa]:œ”Ó³öã_‰Uš¨–‘Îo#¿ÞÅÌ!|NWüÚè endstream endobj -1474 0 obj << +1499 0 obj << /Type /FontDescriptor /FontName /IMOIOS+CMSY10 /Flags 4 @@ -18342,9 +18567,9 @@ endobj /StemV 85 /XHeight 431 /CharSet (/B/H/I/arrowleft/bar/bardbl/braceleft/braceright/bullet/element/greaterequal/lessequal/minus/negationslash/radical/section) -/FontFile 1473 0 R +/FontFile 1498 0 R >> endobj -1475 0 obj << +1500 0 obj << /Length1 766 /Length2 759 /Length3 0 @@ -18382,7 +18607,7 @@ h aaT'/D…/¦v2_ÅIô÷*’XÆé¼VMäGoÆéjeÃï÷‚x"¡‘<Õ©O=}µL¾8QWÃYΞ^L„רFHy�ü˜ÈB9Ê2Îo¯G¥¾bv0„òÆ… 4…Fv1wz MrÀs1§‡zå; r‘*)!´î Ý·Š´ÿÝÔÕVåÕG•8 z±» Ó(O»û+¸iruþdtîOª=eb®|˜Œ‘Ô¤c<…=>òƒ?†!ÒêuóÿG\ïD3/dÈZ2)#Yboµ£˜B§cn“d¿lXë0 ]Ò%ÉMEÚmu`ò©bNßʾ”ËL›ìsë7§F„�“q�ò¿'Z¿TÇ©c9$À ÑPâü<”»ÏÚ endstream endobj -1476 0 obj << +1501 0 obj << /Type /FontDescriptor /FontName /XNLILI+CMSY7 /Flags 4 @@ -18394,9 +18619,9 @@ endobj /StemV 93 /XHeight 431 /CharSet (/infinity/minus) -/FontFile 1475 0 R +/FontFile 1500 0 R >> endobj -1477 0 obj << +1502 0 obj << /Length1 1557 /Length2 11852 /Length3 0 @@ -18529,7 +18754,7 @@ Q àÛ¯¥d î}QŸÈíÛ7£Žåíyè!Éyl£X… XáygŸ{æ÷ì<\XÁèÖЫº¬™º‘Ïÿ.óFInæq޵rw– ¢œãᓃê¡k—Ô>ðgäZa‰…@^xÍ\°u=€ è+¶�<~–§ŽSu_�ß9ñûLˆ—i„þ�ƒ1 hv¶Ï*ñÄàÓjÿïÆ£_àÛjŠ@f—”>Ð*�òViÎÞÚj‘šž›ô]œÀ';üIt4NºmBLÔ£÷äVÉc¼wÕèŒ{5�)òãÛ¶©Ûgöýj¥2{Ûèù†±�ãxÞ¥87Ï1XšJ¦Tdÿ+l‡Î¦Âú4ýé»4 î–ÑGfrÜd�1n_€^étIé69å�uî 4U&iœßR8èFPR=°´éK’8mð�PŒß{û,y1°9RaG~³:b_ E¿ezF”�I<¸˜{ÀR endstream endobj -1478 0 obj << +1503 0 obj << /Type /FontDescriptor /FontName /HMYRPA+CMTI10 /Flags 4 @@ -18541,9 +18766,9 @@ endobj /StemV 68 /XHeight 431 /CharSet (/A/B/C/D/E/F/G/I/L/M/N/O/P/R/S/T/U/V/a/b/c/colon/d/e/f/ff/five/g/h/hyphen/i/j/l/m/n/nine/o/one/p/period/q/quoteright/r/s/slash/t/three/two/u/v/w/x/y/zero) -/FontFile 1477 0 R +/FontFile 1502 0 R >> endobj -1479 0 obj << +1504 0 obj << /Length1 1067 /Length2 5106 /Length3 0 @@ -18618,7 +18843,7 @@ Hn4*/ éÆ 'dŠÿDZ@Oëÿ{Ll§æR%M…]> endobj -1481 0 obj << -/Length1 1846 -/Length2 11513 +1506 0 obj << +/Length1 1866 +/Length2 11720 /Length3 0 -/Length 13359 +/Length 13586 >> stream %!PS-AdobeFont-1.1: CMTT10 1.00B @@ -18652,7 +18877,7 @@ stream /ItalicAngle 0 def /isFixedPitch true def end readonly def -/FontName /WZDMKI+CMTT10 def +/FontName /ATJOAU+CMTT10 def /PaintType 0 def /FontType 1 def /FontMatrix [0.001 0 0 0.001 0 0] readonly def @@ -18709,6 +18934,7 @@ dup 49 /one put dup 112 /p put dup 40 /parenleft put dup 41 /parenright put +dup 37 /percent put dup 46 /period put dup 43 /plus put dup 113 /q put @@ -18737,39 +18963,51 @@ currentfile eexec Ì'EK¿—ÊK�œƒ¥fr•‡RíK^yá†`vO^†ðžúŸv…òõ~ÈZwR‡³ iÞNMWçÐ3HS¢p+§T,q!s�0Ï(عÆ;U–©´+3çÙ"”J8q3ƒÓdŠJñ`£°Èó7›¤7+âçêIªºu®îÅÝáØ¿hH<=!'€«¹TÌ�–€2.«rá% v ÈÜÿy�*¿ÄóS“’˜\L³$°r)_Á`�‹°5_ÜO㛘H&ESãÒqð=�ÂÑ*’¤Ó 4ýÚ¸vØŒŒ s„FØ×䡨—Ÿ›ì37ç »ã£w#[Ç›»ÛfÎA‰Ú·Î‘òü ¯mÚЙ’Õor)�h&î=åÛ|ö6kL×OAD„ÜͺD›ý*â °MÊö‚:7¯õjm˜mˆög¾:Û³–›�DY¨eן�¯�‚±µ®Y,ýªÞšP&cvñXåiã“rãN?õ­‡)Œig"ÑÕf-yˆ€B]@0(i"/³8²ø=¤’œQ_@Íë*êsÜþk?«}‹¾¿ª|þ-×/²ùl’©tÔ�«ÇÄíË5ËXO6½#èa>{|�¨ñýä³É,èÿpÌ/ÊÓ Ð…uNÉåÔ,Q1œ^�qœÏƒZá'•eØMÂV…Z=üÈ,”ÉB:†Åmš[„õ¦hù:ŸóÊsZÚ‡Ó=?€+m+ŠsÄ^3ë±IÅVPÝ{ÞÅãpvHrQêšN¬åÅ=ë¨Q²É|É’lÇn°¢uäÑréè% ·~dLA$ΰæxóo7»C7°¯b•Â&.®{ò”$e9:÷è•yEÄ$=}¯½D…À”pÙAS"~ÈPtöˆñèJ§ªèJm‡§2+gu•çb�¢ß`þŠyß¿¶µ6+­1ýbºs:g“6ïtÑ|n_ãÁ†bÃÁ4¦Ž¥°#ÞálТ [Tz‹¾[ïdPŸkÑ3JÇxvüß4.êD<ÐZ8.næ -0©L‰¦Áb…`‹§öóÓ÷7á|�¹ŸÇcï�bµóæœÔtpöJ6÷ƹuj“r„CµZTÞR‹'W¨ß™Ò¡Dj4hÀùE1‰¡ÓÐØk‡ä¢õ^Ù «ó z¦v UgT#<�hÂ&B!+ «×}Ë8F}±&qvÑbCç;÷§�Yè¦4ïXk<Í…QͶêÌý/·ÆIÏÂyR/%Û3]%?´…2.ãÑݳ§xˆ‹1�¡['mHcS}K³6¼cv,:Ò|ó÷…Oh_¶{½!äý Ù�;‡�j,膌nÍ¡+w¬¡ðÂápÃéáØËÞÝ×3ý�ÙpÊ#5‹V®°nô©ÇVu‘ÖkJñ~·Ò#Bg1d·³;ˆ�·Úà^§"J×’7½Ü RTL.ï#¹3½37Ǥ9A†°Jn]²ƒ;Ìý´ýQvsT�ãËéî[§JhØXæì‹X”pç‹î<Ì)êRf†¯–“ªÊñK´Æë÷Á–™¶âˆÉõCy -F‘Yòë{ÿX‹Xt“[êŠ kà”y$¬‹®ÖÉÖ<„æêpļ)Þ­ÏA 8s¶˜ítmä”6òÎ=îª>~ð´Iâ`~ª¾ - )‘Ó¯9€RüȼѫÒs˜×ƒ}‚2  Ô°°\ðXg `™m˜:;½¸Ú% )dÊÓ„xdðXkÚ¢ýßœ:±æõá-<¢À2·ýåUëa�$g~(u3`“?VÚ#-ÏÄ›E½2Ô…˜¡šdÄ(¶0Y]‰xE‹Ø+d'�Ä[¢©_5Çé¾I6fÞáÍ \ê k~ž±ŠŠe_wÚD¬™¶jŽ&6»¤µë*�-ŸäÝ<0CCÀy¼°XÖ˜/** *H7=Œ­£+(€C¾Õÿjqƒ8�—p”nê³WÓbÑlÙ¢…+¡'b¤?îçË4ôŸ/s¶I‹´;¢n¶ ö1ïBUzÉ‚š9 L}Š14ªÞRº’ùº1<1φ n tY¼šI³¢7XÚxfYå¥S g+¤ê¤õ=¾V2÷�¨Laû{u°â—VÅî)l¯j² ³~îHCÊGr:£aG&U-¨®3†õUk688Þô¯Ñù|B“ÀÙn-_¶Î›1Qµ4œÉc³–³›ßÛ)Ì·ï’~i7ãTãP‘¿‹Ó ضJ?­ŠÛX7é¥0so¶ŸpY`íjn«Zᾟû?HtQ>ˆ [’×>]IÛÄ…h´už–Õð‰¢—ÂÀ/£�¹–ãoÆ"¸:š‰añ#afd·ô Ée±Ô'ÃÔ¹YÛU/8Hl($µfpU•賕šŽ(ÔGÂue€»æâ3xTœ ¸¼;Ù2JKe¯ UWícÅ5%®HJ­ø ýÇRNå<ކuEwÑe¼ôIƒ¬ÊûÌûïù‰ÇHÇA [ÉØ3þ›†”„‘ø9� -ÇJÅæc$ãi;l ó-t¥ÁaÈp¤$õÏ·wmÌáD,IÌI{H7w’¥ñQó?R$ÎO†hˆ$Í—Í1±Ÿ³¢Q•öj¦P'îV “`©6©tÛ2ªü»+> ­„4ÅS |æÊ+xUGkaQ™éžT]f— ÿ½Gqí©îPÃÆjJ¨Î S‡zÅð\ëë2õŸ­]-ÜÅ �ïjºÓIüÜAÒMDSÜé¾FPaÅi Ôõ™›(¾L*´VDæuËð„FŽOb[çQ;öšÛ”Æ_ï±�»ÄðY¥l¤Ìn×îb'}Ýzï&703š9WýÃDd[/™”3²·…„£ÌMRäÍÇÛ)ˉä¢ÓÀ<�&28Y¨¼&P ë<âmõÁ¦ �%Nщ7säÌ0fãq€®�õ”ˆâ]7ûO‰Äô= â"%5þEÜIW¶(»jæ&Fž¤Ãµ�€wAöÞkiµÄ¡J;³g®s™ÐVxA¾?e݉ô\‘ý oP:€È<žz†Diþºk¿ÑĶ'›„ ë�†8_r×óîï£Þ<~2çˆ?HëQr¦�&Òô¨j¸Þ8Ñ(£÷ùÚŸIÔ®‡0óŒÜÀ™Ðø`ÎôJU@¤T@°iëXdšò/ÙU –ÿäЙS)'ênf¦Xdeèÿ‡æ'Se»>n,8’ •Ëœ†6GG¼[áäÞUÚ€-ó'œà œŽæÓ8:CÿoOêÄã};{­RørÇZì¢^mïVöOð‘ªø9³½ÇøVQl¶öþæú"Âó©®Á�ÕŸO��ä¸%…¶c¹ùé¹ÂØs…ùȨ}©­€ çë;¢ Þº :×\ÚUœÜ¨P:(EÔÊn^[u£ ¿hØiÅv=žÇ~¬ˆôÈm„1'À=åÇ8�ΠW(ß«šo·„¤�úܺ�&ZC’î92³e›‹eh+\Á &E)F°Ÿ›fGhLž[^{�˜ÕXn#üÒ` ¢½”ÁaPjð~?È“[àB…t²c¡òÂû$xÇ“°�@ÙÖÔ%"7:[gBÝ¥“oUžfü -Ú)6¯õ›ÐìÙœ¶¨Ûp^¡ä‘2�õÚ4�ÀÑëjh~Ö§iDºÛŒxFTø� ³3Ü÷òÊl Q$¬ÇÍJ.ˆ‘á2Iç±<Á�ö1í%Žz•aÀÐCÃgo¿Ÿ£\ˆ\+_i]V‡>‰œüÁÂ8¾ï¼j§®pr¬J},ølnm²ÊüŠç” -à�Yec™‡ÂG�¸ĶrÛ›ýåÐÞp!ל¨¥Ý}ûüWYŸõ%•ߌzœ¤¸ eë·†’¸Œ—„&_uùDi«,`eo¶zvµ×͹p£U׃ðõnñx½¯˜•ZëEËN«ë•ïä€ñÝ“��è«dJóš¦i†ölÇã„Dñþ¤×R½Ë#¹eý®NëŸuRæKˆÆiC1$΋v�ü�X‡·3ˆ”àtŒÏèÛQ°¯¦dÉg`Jo>“Ì©58p™²A¨Þã>€ÎY£Í º{‹ ªCÎ/׫bdÜ&˼Å{'˜¯#úPûÓúß¼Ìå¾­‡xó_‘:€v©�"�VÊ .uôò]�G8ÜA…ë ÕÓ¡*.§EËÆQôdá¾±ld““TÛ§_ñe\&ìQrñ¶}6ç§QFm¬%ëî^"«„“øs„GÀ+§XÈe‚xx¢Q€5ضîå‡;‡À�®¶tcëaFmYl o7悱´ˆ‰=IÃ[ž’°ê†ÓtvŠ×e‹*#¨e˜Ž$ñïˆ�L?t¿Xá4jíœÒ ¢*À¡£×[÷ ’2\­à dhZªw%t¬›  ï�í«.dcjkk÷(d£]�QN½Á¡"ösK'ˆå‹›“×ü[•-ò¤»¨i³,ˆ]7Áïó¹/.#t�n†ë+?î)Ô8žAÔë/±´�­åŒîEö˜Ü&×Êò”‘gŽÔÒ³`ég½H}ä5‡%§·Ê{=˜ä¶(½�™Ô×ì Ol:ÚûG§Ü[±NXm�z^{Ó‡D#FpD×~ðñ‹Äõ%¦ÇK­‹Rý*1³‹¦ºmxˤe·TŸ5ìÚÐÛyM\õ9Œá–=çkÇ2ºí2WƒºrØ`6Õ?}£©gæbDoÙzŽÜœIùlùëÏÞ;�-Ò¸/©¦4ÛÅnÃOuž�ÚDÏv ¸Î×Rå ã:¢Vé�±–)ÅÅËÙq{èPQÐm?§0ò¡bK{QÇo[ÇÅùÒƒPÜØ¾ÿÔ -ñ›¦«¾yº­ˆ�»]“ŒSa]GF ‹‡�èT¬µ&f-äÞ3kh·¯uhÇö*x<‡¤&Pªr„?R¶fCo•œØÄÜþ *‰sŒ¤[á�×Å#É×R~IÛÿü¨´*r¦-œÇœ˜ �iµ'ð!ª.èVÏŠ;Ye�£o6%¤2Ý‡•ºó¦}Näß�0ï;eþì£5){G̽³n¸v'y“4¹tØnj»§i€;Ó\ý:sÄC³/Œ`ÛbÇ/ý–ð‰½VÐuw7,ѱXœo‡5�Ùä ÏÍèÍ>£M¬[˜»?Ù§O�(ÀÓv¹¹©ðEqðNìm܆¯fÓè�:gqC+rŠ,Ô+a0À{Šús´Ö>µÌí´$þ=BÈs0Iù|åÙåj|§o�†V”~D·¹å�~¤s×S‹)²bgÎfbwמ\.`ŽËÖ|k-ì µ �‚r¯îÐÃE‘Úó‰°ˆ¦_$-n!U+¨.zzøŸä–O�éÌPA)I”™]–ûˉ˜>,)1)JœËÓvÌã~ǬRô�¶ÐÙ²1è >…°b³un’Ó¾Q'6Q¼Ãjª\ÜÉã6q¦>îƒtF!4[ …:q«Þßû9–”AÍš² yg°‘«Üèð§ñ[P÷»>!¿Ã«|“s‚þ�˜ÆGHÜæú:z&Mo•ø”È‚7ÉfeÑäm·k« „V÷|sv„vç´k¿mYFtÎ/‚Ø 1´Gq@ãñY_,š,}*%yïSàÒ™úp!äºÍMw4¹:ƒãQ#`Û‹3ª+>ME Ó�¡'€YOL€ƒFÅgÔ¥ÙïWB†6êðÊBiÇѬ¢Ì…½âHXÚš†T^A( mfW¦v‚Ié{D/H’þF&BA¹ÿ›ššª×ÐsæxEOÀò±^wBžrVƒ¨À§ðTUû|Ør–£¬ oœ-T¯u‘µ2¾6»_ŒQ­FìÍØmEÎ0%Ž!&¾šZ¶hÅñ0ç )7Zé`¦¨¤b0ýÏÚô¥‰î¯¯b³âþNƸµ¢| €†ƒ&9q"oæŒg§PgõI3ãún„°-–ml¤¬<ñ#Ë›E2Žê?¾‚ô°ûÈø`<ëW�GËz õ6÷1µ)È€4=sÍÍèƒsìrའádÂ’'ÝkÅ�i,‘�L³æ–õÁ£µUä–ÙnNQÍ:>'�ä‹N¢�ðÚùÌ7�^áÅ>âÉÊ+Vb²p/QÔåCBiyÓñÊ$qåŒÜäv¯/ÛJ"5{±ô´8m~puüp^^¡Ô喝jNUÄ"ùúp†ÉµÄÅiDr±:)½iSÿx·–p$/7›­$ê Ý8áÿUxŒ¡D¹1¥“2ùƒ$MŒ•æ8éµ]ªõ¬M¦-ÅÎѸðyÁ8žœ´‹•Þ*m~9� ›§m5¾lZ¢€ž‰î»Òª�åa l{‚JŸO×î.yF0Zsµ(IæJñ—%Ë®ÞOÀL)açyhV‡¡ÿá/kuz0¹ñ–êunÈ ±Ö)ÁNÅŽi£·Åu Ã†:Ç2HÔj»Ö%ÏÇä vór§ÏŸ‰æïô?&/Ù+‰Û×3$Ø:˜¶ù*¡8'oÕR‡á.:6Jë€Ê\žRÖÛãQ6Œ ÖC l\PÖ•tç!Y îÍø˜_ãžšn± „6}š‘¼M¼]¨¬ˆr2ÇH�$Š•‰øR5Í*"–H‡NÛ¨LÉa$ÕSlà”èm'÷\ç ½o‡¬ó¢¯B÷É\>å�¢YZÍ¥WKœšh)·(ùp+B„Ê¥&ûפI¢™°)^˜‹›«²öl N-ÆÝÎu£Í1R…ˆ•¿KGÍA)øÈÓ$´ÑIŒhnž&“dಹ4WRT�|(…4ó¼îS?syKÝÒÝv¤Cë -;ôBƒÿ# ÈWt�ý;øç�œ¸ÌÄ’¶êà6º†²•l¨Œ~.˜�&™íüqûnq¤iêòºhQïÖÄ{pæ¶xÊGÝ1W‚§Å%YuqÕ“´¿É³/ï ¬6S nÑ~ߺÄåTKoˆ~FºIœhpgÖ hø‡}*+Í9¤X®ßÀ³Ë‹"#2F"n×]S¨~ãD.¥¸¦´]!«×<6t¾¾ÿhÁÏè~ »&Ãb Vöޱ�·&NÆõ4CZñrë�£]%®š²áØ)Vv¨*¹ÌÃb›ó>ÀcÓðFkÞDÜJK¯×Kš�޹Dž=1X ©t‚�i“¢t,t¸æ IcŽ·õ&B!— 1ZëòÄõ^ØVÉÖYÔ�n×ùBhƒ; ²ªî gtvE \d½l9ÊÁ³+Ó_Jßhô‹&7ÀÆ7û±“®E` šÎ©,†ú%Mâ(•Û¶N ÷˜£DíŽÓ‚XÖ“\1“üóÕu�•"…{UâQv$5ôW²b†#þ”$ËÛËd¡ÄOŒ<ã‘N1¬�Gü)Žy ‘\vÛŠ6D€ÁD�‰Ç…Ú_ô¬êm¹r§‰\ƒs=Ù�))Ó¹JÎ>—3Õv�Üì [¹ì’kÿLˆ}cöuCŒæ:y$eÓС2ëLúójŠ‹Œ+Äew±qš{ïÓ\†îs«|%t÷«À`FÅUuYÊÛ†é@b³‹�o>^ísMpÎ ›;—²1­Â˜q,¨gÊ…‚ lÔP_óË«üW^OC˜ö[�ÎL£oü‹?h?e”à…–«w€�±pô™˜§Û -„³Jš_D3¦ -QÍášôàP �§x˜þq¯„A”Š‚AŠà™0Æ�D—S€L�^®Žz)°f=»�9·O‰eBJø‚�(*M?F�å­}ß!ëmu£Co¼jH‘/0±lºcø^ö|0�5tt°ÁxÍihÚÆM|�ã^pLÀŽ¿ž7wDÈâÃPµæίƒ±Nì€jíÕ‹ â”Æß XhË£ŠˆK�±è÷W¹6•‹ÛÓ=+TÌ!•cµ{yWô žp浸S»ÙZëº;®Ág%çÒþfè¹í4f•Øü,ØY‹Ãò>‚'(Òdí|~`—MŒÏ›—­i¹Â›D g:�¶p ×@%+6âι½ -Xk‘:õd{…*ÀX• "ü€U' 2Qò>V9tå[Ö°ÛlkUé uЂ<ÎØü�äÍ.Àåô ýXd%ØÌZäÀ¨wä_ѰïJ—‰ü«"õƒúŒ±wK¬X-®¯áÊ�ùŒ:èlXfV~iXèú�Æ£æ„&àkžºI�¬qfaõRç,Óxòû8•,"·ãD!füQV¿ïü—jêŽC~}±ö°› ë§1yj"!j ¿v¾·ñ䆔qŽ)Þ*᥋# ùѰ.×’­�‚>Jë™…çÀ[Åâ×36üÂ{öV\ºùê6'·)ÅwKʋŶ£Ø¶kÉqäí蟆kyµ«ÑTIëîæmCBû„ÿWƒàQ¦éŽ(—ñÖˆIʕ锶x™?©'8t8Ÿ (ínqŠx,ºrúÑõò i!ùyü%°²fyuZ lßZDÊ4˜C¼�$7. ±Xëáà#·½fŒÝ1ƋŔCñ> –E@QÊÌ¡|Ó~î¸D˜'ý0˜ØÅ¬§ÀÝþÓ®°O ìÛE¨Ñá”å.i/ɵ‹ <×°ß´n;pX&G›cr�åüÿ[NsOåÏç½ï—XÃÊU¢HòR£DpUÓ^Qe°s;<•Z5·eÍSˆ«—›ÑHQa\̹v£qøìVhކc€ ¯†P¬ŽàWÝ‚i0U?¢”Ähæo\ìœýãYêUÐçbõ²Ø>.k¡Ûw“A:Á.\�ƒpœ*ôªUZ>mûoûZKJnó -8R;W¨,Ï?‘H´©dU¨˜V‡DyÞ8îf»¦.:H£Ý¿œ;BÜbwûÃyH’acÛ¦~Bñ+O^:’ž]Ö/Î(_ÑrM´šÁG~À%Ù×ËW ¬ý‹5FiHµ u�tuëVLVG*h�ïèçwxоÄ;^¼$|§�ñ­�²�ÌU›Øä ÷g ì£éBq|,Ùk9>[ôÕ_Ÿ fuÙ>V{ˆ‹�ªpÝ—•·F†ªÖêã8ô0 =ÕôCß3|†±�C: -fº©8<üE09𳔉šQ]Â$[Ò­ø{�¢!Õ>uM1ä¨ó­�®b¥väâìÕÔ§¥@…ùÐp�È&ˆ�“*é´±raN×C¦’¥§èº&k"*s³œ®8‹$|›öX?MþΣ¯¨¹Ô -‹Š•ÖáÜf³S S£Ñ÷&¬ke9ªóÏbR™ª³íÀp@õÿü.åIr´vëÄ43š•¯ð£AàIgç¥QH¬¦À ÀàÒûÜFêðyæ‚Z"櫱W‰Êl¤*Òæº�ª—áŽ*‰bå͸é `Pw’ºÍÝ&�ºEú u@SŸ$_^Yƒ¢ÄXíÉåŽ6¢®>‘ H‡Î&Í!b#ñð×µLäéèF *‹÷¶ÓÖ™¶´ª!ýºõ?Ÿv9ê‘»ËW€ž€Ÿ;Ê;Z2:šïúrSQ6\S¸p7 PzrsŸ.’y'T;ÿØoÌýC6SìÅ;‡'~ -(ÿE{­ï3y#áÑÆ¯¿¾ÖÛ3°ûǹ :¬ -W©A}í…ÂÍn)ç’þ¶T|‘Ý�t‹JZ4ÃË q‹°Îzf �ãÅmIÔ!-kîy¨9þÓÀÙ”2f/L� -7øù„vò~n²µé&^9ʨkœö‰Ì²9¹`Ã킪nvdJÁ'‹#s|Rði‰*°ìG3Ì!>ë§,´‹¿Uš\—²8i“¾ö>£);RÀÆÊg ÷[� êuò_¯Ð3mhž\~të)áñQŸWZ3Ôú)6h1ÆèÚì`?XÑ:™ÍA;lj„QÞ‡Tº Íúþ¢Yü¥Å„21Õâ°ÃÀ÷Àq.ÐÎ哽6ï\ñ¥¿ÌDÛRõ8zAQ×Ï£3� yü%€ºeZÂ; -5aÖ<¶Èýz:°ˆ4d>zß–t©àØ*ßêŸá1(_f{›À�QÙ*6‚3ä©qÍÎ¥4XaÌ‚<û@ÒæÉg†òÐϸ(”@hg!"¤a2r–‹øø×rÿ -!��mø¦2³µmŠ`–R„ÔF¤ÄÏ!÷›©{ˆ2,ÊÑ[Xcïâ\|m-”øÅáÅõ�{a™îÅß‘íQ,­ÞhÌ®îÄeþ‚Iþ&…,›Ål�TayU­®»(Â@ÂÍ*¼&×Ym@Êî‹Fƒç>`4ôn%‹ó×n»fÖzJ9Ëc öÃþ†š»ßßW9&¬åÜÒAG4u (¼�~„iqϰGïÙÖ�oÂ_Fš -ŠfëÏï7µ£&-o½Vi»¹‰ªðö28u{q<”v•­®©¬&ëЧñÿê6eê[h” vnKž£?ÍG�T·¡BwUú Iã ÊêEؘËYAœ_ ¤Y»>y—Lk3Ÿ(1½tüÚb˜Eà<âB1EI(Á�œÛÌTaìéÊFLÚye) O°/V%ràHöÔõ)¨¨m8ðø7a¨FaT³»N¥d\>½¼²ø'Ï3ŽjÇHˆŠ …fÒ¤ñL}Î z½‚nPOK˜KÂá²zx†!ïЭ®\­Ö hŠÁx:™ä×=J˘VˆBd‚S³ÄÊ œá‡z L�yu>�š[PâRdõӯܜtó7ƒ×‡×³Ï®±“¼ИA3DÀ´4µÏô ¶ ÑïÔë&á§çˆbáôÎø¤Spׯ÷]½–C´3 Œ[37'ùU�”u KK8Ù�o«-0œAØ ^¡ -¶ã¹ݽ¥Â öpGT”`«Ë½0LX\¤½ªu™›@:n³©êE!ŒvȬ*dšýþ·|Áȇ [”\ï èNa (hüSÄ!:œÉ ßF -½{”ÆŽ¦5´^Ø=áu©Spc©Ü¼fRE�²ÓDË0‘ÆkªdKÞ -í}o,(èÉë5ág{èìž”b@Ù=Hà^ƒ‹Ù„^½.M1!¤Ãœ«žÙI•“£Ymêï (ü†ëþ:$zôö!šŠ‰ö#Ù­äl0„5¦l;‰\Nÿƒu›¼n¢²@Žû“`(à ]KQWf@ù‹¶—ò •ä0]ǾmZzTÅZ~鯕2 g¦kv0·p.þÞN61FpHç°à !þÌQ1§6¯Ì w»žèy»²9¯Nt6Ÿ<£‰IG•­¬°;=PLø9ࣛª�áPÎfï×Â¥Àö=¦eÝW寸�Í&&!l�Úí´Ë^‰Z¬꘹âc ì]™’Â9~{䓦¢3ª¾x#½‘°2#±ãúÌ‘8…�+?/¸u ‚¢ïQú�Ìñ¤‰ÂH¾r»È “F*£ÅÂ#ƒÂ}þÑQˆöb$å;Ï0¹JŠ™7^äFE=¼ †­V+.BdÛë= -×Úø®Éx4úÐ B#– v¬"ÚrÁõäa%ü2Š_�Ä´´‡ ‡ÿ§ u�Ç(h2ZoÏîຉþN&týБB3ôQ»%8Î)ûÑÞTÑ-i‰FöK Ç):uŒRö¥„7|À¹A³Ó;>ê(X0sxqïf•²”n{ØCUUª¾MÅïÙ/|^‘7Óç¿ê¤ \ÜçŒæÜ‡¬øÕ»£mÜÅ(�‡=ŠŽ÷¸ª|±ž^† ‹ÈÕã ÊŒéBý3öi?Ë3ŸôŒEÿ·È|Ͱ¡P ™tO†É5[ZOM•ήr s[y¨Žu5útïË`ä@ÑKú°"G%·³N›…:vP�Õ°v³ßo§Î*@„Q‡Ã࢈—;h—î¨,‘#éªõ×Rx] 1Àyk´WÈ*ƒç4ƒHtm<%ŽÞgäçà¯ôUÂÆê�¤TY7 %tîüm‘�ß!k=w|w· -™þq¬ÉpÎ@{‘¾ÌÏí*šrª¢/÷}®Ð‰¨ˆÏš�Ç”I f}rjy{Slu9¶¦N6ÖÁ”Ór^gReƺe�»ò5†BûT4¥u›µ�83Ìä‘Ï;[,º£ÂùFG�#‹D¶ØÌcHû8°'šos„@}’” )MlVS±/Y@8²Þnêë¤L} å¨oÞ�°\¯x½fC"Nì4âhÖȺVŠÜšýÀ°ÅZyxwÇ8:Š”‘ŠÄŠ3Eîì1¯ µÀm6–E·0‹‰" aÒÅY SÓ‚úÀ¶jf²'åà.Ä’…s·àp±¢A]Síj£¾p°®kÞ©d‹½ç§¢MÓ›÷êkÍ>…wãJ•Ú¦–ÓÄùø£íÅ{iÅÉ!sb‡8iìwá—ùå.»ô`0D 'Ç„·Qy”`ì íÅ6r‚’\ÉÌÏròà\ƒz ç»�YQÊÇÿÿpð¹ìb÷�\@~¿±7â§¢UÃÆÅy H”àªé3lôn—фʗvÓüeWsUîªëŸa†á+iH߆sãEx$y·cåˆË&UGæ® q—·íð <à;ñ_ÈËxÏ¥uÛ D"L¥ÛÁRÞÅa@„…-í@‘-~G8¤ ­ñ™àåŒncñ�©©Ö§§|A.§xüî×!dü\}ÓÚéDêÄfnp¸ÔÚ„%5›Fö #³T°jŽÊ…rKƒÑû~`Íž� AÖ%öd>ëN×uaVaÔ–?3׺ºãÙŸ\ÂU_I §}ôú]‰4Ÿ a~œ´Šß{ˆôŒ.›EÙ0­+䆴×bx׃Pˆ4\Õ·c«µÅð¶¡üû>MÁ!ÖfMƧÛ4]3ñ.:·°_SÏ<‚õ‘æF3ñ~3‹ä‡ÕTà\°€1O·£Íœà Qk$Z†)¾SUñ¾s"ÜAŸªŒ jù»’$û¶çmHÀü -²cql ÛkðÙ‘»œR½®Ñ$9ÜMÉo ¡„˨Ïgó#8¤tñÂù  öQ¯ù-s'~6ßöb±QÍ÷tÆ™à•_,« ¶< #›ýï]°›Âø%ŸÜ‡’Ls+¾•®ia× ;”8DãõÀ—߃fþ¼¨©9¤Ç,üÌ™tlôî¯yƒúX–ÑH×:'€VÇó¢ïSo§^ -¬WÝ-Cr¿Òz$üÎEÐÖ;ÎzÌzòŽñ.ªk½½øE¦hÊr™Å—:_F=\§†úÁ€x¦9îNzœw×"ÿcM+ºH…èó°™ü¦Ôn’aP Ì8Š£VÅÀæj̤3̬_Ô=u*Ô_¬ˆž¬866Ɖ2¡ÂEÙ•”€ƒW KÛ=£J»_Âqçâ=Ð…h'=Òû!“ãSÙa Î>P7ÜðæÒkGyÒ àÂVQ¥Ü~;Šâ‰ÉžÒá þþ»l“%6ó•ŒÐP¼ù &Ñq#8­R:å°ãSI63Oþ3‡8ôó„Š›´½—b¨kNÓ“¥¶œê½,1û`Ô#Œ?–»pk«ºC·ä«à ñ:6|8™së?´Áàæ´èIlÃ_’<»Tµ˜%½½ÃâE—Èum¨Æ9gòÒÉ8i ï¨UN ïïîGL¡WØd ¶ì¥ã‹fF‹¹`ÀCu »àøcg,|’åÿ¾Ñ !Ô*)Óaòx�—JnSnÉSµ½ n¤#­"ã»îÀ“c}óKåh3] ›ßq•Áôoå ôo�@YXÖŸÙ!Äž !ý¡¾û›í¤Ej -u|gã ¹ß ÁÈ:’øßÒåNgJ‹Îqÿi×!öØ÷G΄")þ»%[ÚB�r]õù¯vvcµÆ'�³¥@[ßòË~óZ¡µq5é™Û¼q"òÄÂ&‹úM¼Ò´#öç?Ïbµ¤Æžºw¥1P5v—­Qk8I× %TÏs…yv�»3¸Ђ�¸ƒ©z6ôØ5ÔjNæCÉüÐóŠ„>2rŸ,¬•Ðæõ`ÎTì;´¡çØ€¯Ä(éÐîm%ó/MÙ:#ßá+ÆzªÛ/éÖU¹ºç¥¦¼ìthz£†+£]E·sØsV ÜpÖg‚ ‡»-�fÐØGPÁÃÃ;X›xÇÌçúf ØúºæÆ22\* -GØäfÓYo©¤c×cë1Ï‚#¬r¢É?ѱÖNÒ�ÇkžØg=W,G‰—™ƒ€Ö +0©L‰¦Áb…`‹§öóÓ÷7á|�¹ŸÇcï�bµóæœÔtpöJ6÷ƹuj“r„CµZTÞR‹'W¨ß™Ò¡Dj4hÀùE1‰¡ÓÐØk‡ä¢õ^Ù «ó z¦v UgT#<�hÂ&B!+ «×}Ë8F}±&qvÑbCç;÷§�Yè¦4ïXk<Í…QͶêÌý/·ÆIÏÂyR/%Û3]%?´…2.ãÑݳ§xˆ‹1�¡['mHcS}K³6¼cv,:Ò|ó÷…Oh_¶{½!äý Ù�;‡�j,膌nÍ¡+w¬¡ðÂápÃéáØËÞÝ×3ý�ÙpÊ#5‹V®°nô©ÇVu‘ÖkJñ~·Ò"´1:#²_¸A3 +ÿð©øôe§Çy/ºÇ´ù&6ñ˜yCþêþÅ7/ÏD&¸hWR0¤°>pE‡9*2æ´×ß2Ú_¹¨â‰n=3'fÏK€R?ôš Qož_z±±ú•9�õó¾EN(Ði7’ÞûÐ9&™é©6™EqâבÄ';¾X¸ˆò<²Í +nE’ßA»¤Ou`¹¡EW˜a‚Ô`ci'N/ç K嵸¨ü;wVwXâµDo¬õïNù9Î…Óý½«:xò'H¬A­›<¿±ó¼Nf>8š¤œÝ9ÛëMÄã%k;êo¶-vd,_ d<)¢Ù»â‡ÇxxË—ôÖbWÐ1#ôŠ@t'G‚¦èþéV«˜oñLäyÝGpª}TšUÆ­.;qsío�bBG”ƒ×�ÊÙÖZb€/ª‡ÆVôù­9M‹ê<½P +9�„JžŠ)…}·!P܈e‘ ¸Nl¹0°7D¶³lf<ïÌ©•»aÆ ë±—’fDïðQÓfÝ ïuðÎó|c;»½‡ÁFWFi]ûÉž%ŸÆ6¼¤K.óÇ iûËóc öOv•}µdëGÿÝ� +¬<ÜjöätòÄ㈟&i™!ֵЄºóKmãßÃN2N,RÒ¹‚RÕŸ—mÐÎ0àb/ªˆWH×úM7’`Þäòhy#}ÈðE­ö¥tB‘oa&€ð[0i…ð=‹hŒ6ÌÎý Æs�Üœ”L �£zULò¿wÀ9fóÎH-ÀN^«}Ç¡ò@È6ÆÊŒ•a@ÞBguò{.ç }öë–»9ÌÚªv[“–™è=ê)æ‹ÏE÷x´Ë§`Éíæ€™@MjQƒ÷“�®Í;ÅI1&sÛƒ@Ýk-ßo÷2Žo’Ž×~V§ã!ÅÞ¢ +—r(jvቀè(ÖÒü–�åŒY,¾æÓ}›Ñ(3ø§¬˜å”FåÒwš…b ¾A �þ©zåc(¡Äàlr“¢]Íëš¶1zøÏ]—Ó7‹°ªÜ÷ÿ¾ŠßȃÁ `…‹)_%Ù³#v?š%ñÇxÚž‚׺ÇÏ·é³'Bõ:l˜/‚Z^Î 8_«Æš–ŒåVá©i­3ß@ðü!Æœ¢g##žñË6EGáMÆ…$Uü³l(Ë�W„ˆÜ;©|‚q²h„€¾«ÙõŸ‹G +„b„`lÒíª[΋2qß�BVG.ºžùåõ;ÇFÐÓµ I1Ë=áhUåG�Æ«&¯¢T5ê§ÎÚO‡Â%Õ�ò–¬FýÙºƒVrôíœY› c¬FÛ�n‘‰›æQ~¯ÿ<L _+œ«’×;v®±`3+ßwNrZ.èÞŸÙ©–ÈŸÍ€“åY�†ÅÙÒøŸ×:M…9#UH‡i²}yÀø çÛÖýãe€ŽÕ¼æáYi“Í-¼½ûLW¤©’ñû2 ðµ¤Ž3ög¯ð ”m }Ç!�x¾OÌS4ÚçÕos?óê’¸I:—$å¿:^ç^aš®E9�Y»8fqIò¶sÒÈWÙ�ýÉq "“+�Þ¯gx L񮁻? o³w¡1Ñß¡§Ê²4âŸëÞÑ[Ž�* þÌÁ¿òj¼{ãyÿ>×ôTÕæù¤K5…ó° ±­ o\0 y#œ•úZp k‰N]Î üC½þ÷Ï¡Ðr nwUCú¯c�ÜOBB›ç�ÖH `±"t4/?I«"¡V†.�9|ºL p±æ|ˆq�§8©U�Ó/DÑO�Q�¶âfI¸"kÞ¶Ñ¥ëåúƤþ’6”¸Ôus-_µeºðÞ¦{�X(S-$_UTÀ”.J�†¼6‚´ž{"iÚ'v®V5y¯]ºJ†ôƒ¡12¦ŠûqRÈ…—PyB@É¥áÍ©5¼üOg^¹^®� ,0@¹]ƒ�²ww¯5Æ©�ÉÞqù¨½¤íB.½ò}½}‘‚®´½cM §àdBäæ�³ŒÓ‰‹õЬr”¯ž†:–XÆÕDddÐ6,í(ÌOdÒ#´zH’<„$éÃèÍC1¢Œ7õÉ[ÂWöÍ8A—iM�Üa"oÔ9Ðm ¨0¯–|³ÅŠzbÛ!yRî/z‘­›]CÈ=—G²4{¸fæø$7p�Ä !îã\GnÁPT¦3«{ +KGd'ÂQ)®³¼)ü¯RQž»Ê€Õx� +uªu-æü×ÓËï°1 +ÀòØþã\L4Y2¹Éþ}á*šÊ(©ðM73‹j-žÆ#¼Y|åãªÿæ>°0” <ô.ƒ'ïÄÏK½‰ªûcPS[Ü¢]JÇDW>þ^éF:ÛÔäšË— ¸Ò}ògÌì`À6¶A ñ fðBx�*Ã’�2ZþraôØêªð#²ÉΊÇÖqQié /w:σ¥«>î’õ ç,íæhÕ‹ -â}YaV0Œ[�\Ül[‹œ¶Ü,"ºë“–okϧтɷ�!åg¶ìw|AÜn;¨já9Æ øãáüÕÏS‹æ«�"N±X÷¹îƹ"߸ÒýàÃlö¯=·ß/+ê%÷ÅP»éÊp˜"‚å�´ç¢Àt{å\u xyç€m?©‡MÒ+8ÙîÁJ!˜{—{‹è§uܰiƒöHµÏw|ù}·TrZ!óX~Ê7îNkÛ’ÎGÀÂ/RRÛ6â!0E–J÷šÓ’è/{cù3 • +0yüö(9‚ Ó&„·ÐYKœç^)¢� Ži°®ÞDgŠ¢Þ; ==âc(tËÜŠ‘E7z¥¨Þ ¬¶Ø9Q¥ò2î>äxKÊëXÕ[ÀÓáÚ!1ÀÎØ5É()ßdï­î m7ÃõH�èƒÅÁÑ�÷:a~s +ÁÇt킌MÅ�BÜkHµ¯ʶì7†©ü5�4-^gÝbRxü\ê îdþÁ`•NHq”jR8v ¬žu <-žŠ‚FÓr ‡äU"ƒÞ°“`[­¾ç-`Iøº™¡N~tÃïÛëcjE»,üïýåBð+.R¥tToái)ÆœøÃÄx8µ«ÆÂÝowç1tÉBÚ®Yž±oç²2]Ý€ë‹Vńш™jÓ|�%ÚgôëA�—¦JÈÊ)I‰éHOFº63©×È�¯S qÍk„“âÕd­PÂ>{1Ôiâ©Züª¬ì2IýCX�;Å0›¢ŒK33´®eÀ�–3Õvm”’v'õ ~qNÊÜ' …óH¢iÐ�ÄQuÉv¦øÏDÌ�ª?â1i»#�[ƪ˜´õc¦ÖÝdÄ:sµ•°>�EÒ›�£àÖ‚Ç˰ +"ÂÁ€ñ³&΀n©·®²ÒaŒ6M»|mh¤­Y `NµNÓ£* ˆ¾ÝîÊÀ±’ JyEo¥ÛF׆�ÅÛ˜‡ûçgd–ú„¹ +Ì0ÉZÔU ¦ÙÄÄ�J—emøg—È|3e@w‡¿�¯xñ&RÝ×M¾òÙŠZ±Š¢Gmüuùe5d>J`›xÃÐWöÓ@¯^^yÎáôÑ<™|¼Õ¬CÁªâæùN ¥¼¾ _Rùçd +ßÑôfÂÍ'pGS÷jÊî�ˆ&6ò‡hóP»…cŸíPÝC»w‘Á{ü6-�¯jŽøä‘…ý€f†ôÙs³çÎE~íÅ׉|©H<œ2 ò¢ôO\:L0©Ö$–6‡?,»ý‡õÌlØ#b]v¸V—÷±uÏÇ2ÖÖäéß÷óK›ÜM8Ú4'Î>Ô jé%e¿Ê ãÒ®A ž& m6�À6s³ @°xâƒNn�ù™¼n:«Lã–¥UýÀqqÍ­E-w�d㜦ß<•ÊC2w«ïJ‘ð±‹(£ô06ªN ¥~LòµÐ!=¨g5²&fÀùìyRîíF–²T*›­=ƒ™­pQÙ$_h'eŒMúÍŠwZï+(ø‡qÕöýLÒs#áTûéNï°øù� +B ÷ ‹š +|ù Æ=Q»2Yß‚.¡$epD1�.ý¶.°ö/!VK+§Ó&¡<ìÞž] Ù¯P�»È;’–Š·<Ä€ešùz8Ê*H"FBfåo³BÖj½£õjx‘6½þþ˜±°U|Û$ìžà¹=­öc˜¿ß™Fî�¯w!§nA㇫˜÷bï[Ñx÷í<«quªŒuZ%!T…³¾‚I-?ríÍ I[} SQ!ø ÂvÜkLK1Á­`¸jýØmÁ‰b¦�Jù0Æ¿p´RÙU‚E—hI‚LTt,ÈóBX�©BÉ¿èÿã“È5¼ž^jW3?N�½AgêTgÒX¶Xšp7¹”†z��šJæãVÃVºu°Sq—ô||™Û‚àR•¯Jçõ•Ñ w0x,õ×%€\±Î­È"ãÕÄa¥5âH¥²;I‹‚®£«néü�úâ±±’}ÌÚ€£Ï…˜‘‰=âðk7Þ¤OòqøÞDËi}M:tÔ»“ixFWÇOΟ„Œ†Âz|9ø²¼(âK{œX¾ V«ÄÔS”_ñ¡‘aeQ£ò"lùào2 £{Ÿíž*�gsC¤è”Z¤´Û¯Þ¢Ò- %LLß»ìÚ¥hðE çáÅ †zfÑ‘ù±ºÈÄ@‚úAäæxŠ«d’ªÐ4$Ü úÜ9Hë û�m¯ñM–®Öæ÷S¹ZÂý6›òHH) ¶+Q}x&"É<Ëvô$ËxU{–U.ix�ZÃ]=NÂ&ß›McØÏÜm‡@Ÿ (œ&;f‰HÚ|­ú=Ç’ÙßÈKC†ãHÐMƒWŽš™•òRÁeËÌœ¬‡HŒÎ{ФvNíýlÎã<sÖÍoÖ€ÓEZãàGp ±Ð2^\?2;sË÷Ln? z@Ø ú=¹OxhÎãt¤!‰â É—¨Ö‡Aiý ùÒDƪZÊ;ñ—†ÌhµÔðçVÞ#*èÃdú! •h¹¢ëÞwcÆ!l7•°»r5¢•C•tô•2"Nªi:lCÞK§YIp�ò�ý¨ÎÖΰ‘; +·l׉TɆ‘G~8v€Â'Õ$“\Ÿ…‡W '�°Ä¹€¾(šî£þµ"ƒ™e*Ç/´’„µíÛ÷®ýuĘx}ÌO];Ì0ÎtdF*}ú£_’kZ¿(Òð&ÓµÂ:qœ= •ÍyýüÞo›¡,ŠOW=Zÿëu¾BþÈ?2˜©O±„r’²…”¬�™ÎyvoYA³Å,Êåh/ߤçyG±ÁTßéäsÿ‹—#™v.FÙõ¦[ ¼gi5TYc æ +Û&ô9°�TØŸ Sû±Ì$Zõ.ŠÎÅj2×…°â¹Ë~­H²Vè Ä�Hk•ƒŽvQyÖwd¦õnÀežÉ¶Q¶Ê�âHŒ5ñO/è­IX�;®º¨!«¼‘à¥n�Tú�Vó?›ÂÑ�I�©T$…Þa¿Pó�lI›mØÝyÏ ¹‹�¶a¯aÊQ)Yjvsød¬ÇLt«Šü|˜µd|.¢‚Òõ"A³�DcÁJ.7'q̪rÙǨçN˜,CEËp4<å$ù³å—%ãôHÕfK®K1ßMà–…½#ž�˜¶‹»8/?' ù#³)A7�Š·dÞ9×YŽÛ¹ÌC«65ÜèÀ`�ö?–ÞHœkÓ•»°UZdÇö¥ÚlÕDqgEˆâµ w mÓ¯.Œ!ߎèÒ³Á¼Ó2hÁŒÎÝûàš©L²PÝæ'â'jïI¥É$AáÃHmsö‡[ˆÊÓ#]�o ða^UPã»rT»¾-=ƒåˆ�æà¶&µy Š7œvªÖ×Ë‘0coÐ�(:ºGxñ*«�y‘ëÆy2Ü„šûo©aXT soi ;Wc~p˘³±is‘»Ü`>ÌG'« s c`Àç5j7ŽäK«›Pªö£i�Š~�"‹À#4Ÿ÷õ‰dïx8 ´™ö�ŽÑ‹vÓ— Ê$æà1Ã𽎻ƒ©V*¶tK +@-¶à3^,å¬&ßù<¿ƒñWáÆþÚ¡êJgËOä²ÕCV^¹–ž�>"LñoÁ·£#=˜CÆ¿S¸W.¡±|ê=™dÕ½Ÿçºqáw'¸£èž™¬…û Ò¨± öµì¼&dùQ,.Ì3GCd‘XÓʾÏ/cb™ÃºÀ¸aM€,w@ °`àØçI@úMìbܱ+º:µS,½Ï Ü3gN‹[ !>×”‹üW3�Áyò20Òzú )"uªxe’{»€ggñ¢íXáübgñÉ+|ºI:%Ú#T`â÷ …0¨ÖÜ9 nµ>GÕÒIv�çL°ÙÆIõ%¦È¥òINŠÆ/,Àv� oIê ‡=sÅ[Ð ÞìJö1½è`É ýæ˜L¼ç-Çô›ñbš¹i†2Ý÷1À¢"˜û�7–Ê0Ö!ÙÓWhCN{1ñŠV�>‘ƒÂ$" ÞÏs0"áyõ:¹ +$7êäœÇ¢ÙòuwEo@!€Á:j@—Õœ…P»BªÂxè>¤=Ø«,1Pµ­w“âþ6‹ëŽn4²ðe³jÒeÿyð‹¹Éí!üBË¥úwr~[Úïû4I5ݘuwÐÀÂ}>yLJ=·‘–W<àFÏ Oo¯F¢6‰8 +u)õ™_¨óõÜÍ×ú£ËZ®„|} ëa™4e—4£¸ÇúŽzÇO9s…’ ñìt]ñ‘Ð_ Çþ|ù›»Ø¦—VÃ9—³w+…²Å�ÁfD5 ø=Æ ‚£Â£,ƆN9®èP÷*¦Ám)úàÒËi%‹8: VMÄàÞ~1àåjD¥:ÝΖƒƒe%Œ �EúOÌóg 4,HÖµ}yóæ cÀó<ÂiZ±‚³r#ž]b˜î› Ì¿m†©­P_¯¤Hþ�ÈÞ …)FÇ^¨û/?j½ˆLšU'çO)`®8C�ŠvŽã†¡÷*âL¿==WZ÷2�#hÄ´¨æ�¯8G‚yz…SÖl„ÐÅȪº'` ǹJ^TÝÍŽ|”&õÆëЫº�ò‰‰Ï„W¶$B3a¨Öæ0¢�QsRŸ+ôá΄؟…ýêÉùš[óÎAeTëÿ×VøÎÜõ ØÇè{Q:¿ÐŽGEg1ž#X¹Zè“x†&äeû›À�-¸¡šW¢pÔBÊë6týkÿ1’GO ®Ÿ»‡%ÒikP”$Ø.Tˆ©·ån‰1¯-åC+0ßaoÓÿö^ƒt&SÌ[ÓD(‚L~‚°qÁx‰$¹—q“º´±U¤‡òÕ…Åpö!}Cý�·¡?1U.£ªdþÛ�žDY6âÙÖú¾ìCÕŸÙôŒ–³MÝEÖB£LJ±²ŸS ÏÖìˆ.uØÖ¹/騂#E ’÷u!/5±¤b²„…Rs=ÐzÂ!X>=S�wËmçáë¾I”·=¢®~Æç˜B¸GÌÑ +¹µ463Y²«iÛà2ö‚ux†×~ˆO¹b ÿ˜‘@‚eØOÂö =ÒÈ5I£/ˆ¦^až¢†Ó«½zïnÉúc ú–7‚w¾{>Æ‹ý^ݪ+ó³~t +7ýfsšï±å¸víi±÷S¹�ô°BÛø‰˜å�Řërj/¯À¡ËÇ÷µìš„;3öÂr×1»- UŸCÓ}Ç”‡ŽbñÏ øB¾À÷Y>­BSâI~‘Î3å"̧=é(Æ!—– ¹®ËEéÏ1þÀ‰:§ds5JÌVgŒR¹°à¸øåðW”}'IÁcægW8‰•ï.F;‰„S•ÈùÇë&bT¬fÝâŒì‡¡éØ‘@›Œ"?‘“2¬ +ÐÐsÃCP¦v*¢=(Vs“[·LT�O"i.g/\Ò’òj”ް_–Ñ®‚©BYB‘Ÿš·œŸ§ê¨@�XÎOm²t˜Ò +Α]�irëÊ›cŒŸ8(;IÈ-¾µÝ|¥¾1�ŸG3ÓˆŒ?ÍÀïæy½/p 7ªÎžä¿÷.[¼€`L M`K7Ö !N?m–? ÛªlàÊ_ÑÂ�iQvŒ{ØoM•`pïDÜ–³%ˆS„šþPxѾº¡ðvÂÅÉìÞtºŸ|ú7Y–í+sdAm{V4!NÆ'A)Ÿgý€þ·æ ÀL¹–qþô몢áœÊñµ°}ý|ú0 ¬Oöfħ!ÁòMáK{2c¹ÒÝñO8›l™LëÉ)9Eš +;FKQ¯Ü@p‹À‰"ýÎÓ»FU�Õ–Ë&K4“Ùó vv£m†tY"âŽé4rÇz˜�t�“MƒÛšÓ±&›„GZ䀷لx�ž‡ƒú·£)ŸÌ‹ú7%~Œµ”ôd +~Áw¸»›]z4dgðFwª¿ëªH�áÉ4ñ‹:T pÀ�!‚Ê +˜þÄÉ~4?ðÑ3Ͷ÷'‘®@?=í—(¨£[öí,>ÔJó»©JzA>,pòK•Ö«rt…#6ŽèKC™½à—L”0F{ð–Sú‚ÝKÝËÞ—¶{¼üªEÓB2øv[Ê?ÆÐÔB[ÂÄ]<œ/NÌ‹¸ ׫¼ŸZíxÞí—4±ådö–I“\b#�ìGW^d ö#ïßâå¥;´Ë«$Á$(%�–½gPŽ¿ík@ŒETŽm°ÙÊfÌøO䄟 ¶óí2›Œ—…ÄQe7ùä' ‡úMI© Õ­, ‰úÌäa€ÓmŠÿ|ÆM°’¦5ËÃjÍ&ñ´ÉcàŠÀØÖ̈ÒpY2‰ ³ bËΟÊct{Ù~J“Q…ì?Ã4²P̧cÙê€ð‡p:åÄñÁ̾é Ë +1awö´â¼RexZ±CÝ$¾«C¸ͳ¬¼ÙËâ�t©8"o˜ˆ“À-`‰™½]AOù" ÀÊ•‘&­dº’¹ÿg[ójÂ[YÍGeÔpçW1¹�ÿÅÑXÍçP+}ʳÇãÏÚæÈ†“Ú<ú„ÀîìXae“]àÍåÌúîúOª6?e0eB·Îõ¤�þÊIÆœd°F2>Z•9ذ8Pó6ébî„1”ÐNæ¥S£t,RYýØÙ‚ûܚøwóCê ¥^·WðD»X-7� Í +ö(ÑM•ò„E$Y¼:{rŽ ýØx%RR”Wã /"tXÀ@®ÓŽ(ÂY– |ïj:Zõ¶Ù‹—úÖH,øõîdÂ1¨÷/g6͸ÁpsŒÞ�D¯ÈVÔ…ël#€W0” ýoú’댕ŒA(Cäç‚þ¶7õl‡ôy:jßú P‘õÆ»m¹ª\¡ŒWdV‡AœpùKê'`]=^à*Ÿ­À.�|;€ÌnmÏÌÔq�*þ SVï|«þ£TG�T‡�©9Ïì묇e ·µzu7ÓP–Þ At�€Páp•X,ÝÙ +Ÿ¿äKb¤XÙ‘§i”¥óO ŒÛdb=›ëßfU¼Œ�ç3…é­lkèkpGði»ÀÆ, ÷w�Èý"ð{©õƒ3¯Ìß$#6ãî£â²ÝHôØhË髨¦ ]ïÀJVÀdÁðÕ@±Q¡@ú„3p=‹ï ¥L~€w÷Æ+γ-hÖ¦EÌÉJx¤ˆC™Ô'†“b}žÊBhvøÂµ¸€ /×õlŸYŠ­eˆÀ&»ìTB~«õ’ºÊÅ0Í AÛ…^¨ã{£°è| APñSëcÄѤG^]'¸Ÿ­„ñjõß÷Ûx¤Þ¿têË@iɰg Ï²B’ jÛ.$Š¿°áÓYS…Zù›G†[M»Ÿ²Œ¶*‘–ª¶NXc÷œbïþ2c³µ8[,¨éœ‰C¸}[çO±Ûñc÷a3·?�mI%2Î{Û®¨r£E¨¹Õãû4LÛ»Lö5üñřŧ +‚..oÂC½*Žlõ0ÙÚò]-ÍÇá¿ö‚²(¡„6;ÃÝÙ©aX·¨rCn·@+ͽӵ´®oJ{ë£ú¬H¡Ž² ¤Vì¹c%Bª1=ʼNÚaϘ«'•í|ûíLhŸ„PÎ{àF¸ÁÔ#æŠÞ¡ã§Ø9Æ‘¤M`Œ4g³'lðÛOK½ÊZ€/�¦«ÊÆÖ¡ùH%ÿ³áðÚ…ŸôfàiìŠGHc¯‰Ê‰9ëáö¡ÎØŒj͈õ!h©�/�rÊz#¢© +/h�‡þAZîZHùvuu;6ú©,DÞMõŽª÷ Xa;cxýÆ#õÏ0œ�=Œq8ý&MŒ»¸«ô2$^ üä:Bƒ1¾†=¿ïšiª†øÒ±áÆÊDákƒÉì'ÕÉi¦Ì÷V�Dí÷5Ö +&t)°Æ$5>Q³âk;²€«aÆŸ*ês¦>„æ Œ\iaØÒ¬1÷¹6Ï}ÔH‡VH÷”q¶B‡Ö9þ(i”â(�©šj!’Ö…àCdæ?w.óx³Gê�0?:Ø�o䮬ÐðDõYhö:êÇø­k˜Kf†ÏÕm²“ý|¶\F™S„w ¢TÄ>ûx^1ÉÐrYè™Cí‰ø�:f\ˆ¶¸ ÷`psayÏŽ%ŸlZå4'Ñ~]ÌMçI2æøNñ««Á�lZ–D(ž©£Á·Ùüº¦U´;²µ«ë…‘ šG9æ»REOy0CA¸iA®­� drê�2PÝwžª¡yÜ †:9YòجØaE½ß/½+]ÁÈãájøºè_p#dõ¶¯` +|´ž·Ç;™´Kcàf0qjzü¶qØ5–½™R\5¶°3Eü§ƒ¹ˆ ~�ÐqWÉK[²øF·“tiL!ÆNÞžÍGK:O —I£O¯AA,õ›w{^¸I•L5áü¡9y¬‚_øôøoáZ�Ò¶ÊWvùÑhÂå/§Ê¶^¹õªïÖsÁ¸x +âÇ9îÎh¾•·õàû&ô•ýÒ‡�Û5KÉÈ·híûqº!þÓ¦!Y’ìÂJ”É+m¨4êJù9ðɬ>|%¶©D(åìBè%�Q¼]21j�l7þ’ÑN¥‚ž5§Ö£l�E¯ f_бieè¨2“„#«©!Ÿo<ã3‚™Üà3 =¯ërôEgMÓÕ‡^-Ì&p¢%ßѵùLæ„7@³¾~¤Üá _Õ`Ylk´S"7’Á½e vR-¬ñ#-èt’þâ[»Hš,'½Y#ÑçX³ÌoÇ�ÿñF6&ùSPu~dÃkĵ\;žÏèpðb¸3^æwÍ.øÊ•¿oEUí²PöQiýò‡oš;MˆzØItÔ%7ºÇïK±Ã¥Q‰{„ñÀªÑ½±]]0¼ñ͈®ß;ÇÐÛ }MlÈ0gÙd€ŽWË™ƒ Åâ6“=$'�ÿ:T·nP« C›Iu…ë ôãk/°ÚÁmñ¿€Vû+U6 äF‡Zïxþ 6 endstream endobj -1482 0 obj << +1507 0 obj << /Type /FontDescriptor -/FontName /WZDMKI+CMTT10 +/FontName /ATJOAU+CMTT10 /Flags 4 /FontBBox [-4 -235 731 800] /Ascent 611 @@ -18778,10 +19016,10 @@ endobj /ItalicAngle 0 /StemV 69 /XHeight 431 -/CharSet (/A/B/C/D/E/F/I/K/L/M/N/O/P/R/S/T/U/W/Y/a/ampersand/asciitilde/asterisk/b/backslash/bracketleft/bracketright/c/colon/comma/d/e/equal/f/five/four/g/h/hyphen/i/j/k/l/m/n/nine/o/one/p/parenleft/parenright/period/plus/q/r/s/six/slash/t/three/two/u/underscore/v/w/x/y/z/zero) -/FontFile 1481 0 R +/CharSet (/A/B/C/D/E/F/I/K/L/M/N/O/P/R/S/T/U/W/Y/a/ampersand/asciitilde/asterisk/b/backslash/bracketleft/bracketright/c/colon/comma/d/e/equal/f/five/four/g/h/hyphen/i/j/k/l/m/n/nine/o/one/p/parenleft/parenright/percent/period/plus/q/r/s/six/slash/t/three/two/u/underscore/v/w/x/y/z/zero) +/FontFile 1506 0 R >> endobj -1483 0 obj << +1508 0 obj << /Length1 1289 /Length2 5599 /Length3 0 @@ -18871,7 +19109,7 @@ z(# uÆÏOWX*ðBR¦Á{ endstream endobj -1484 0 obj << +1509 0 obj << /Type /FontDescriptor /FontName /LEILHS+CMTT9 /Flags 4 @@ -18883,983 +19121,998 @@ endobj /StemV 74 /XHeight 431 /CharSet (/a/b/c/colon/comma/d/e/equal/f/g/h/i/k/l/m/n/nine/o/one/p/parenleft/parenright/period/q/quoteright/r/s/t/two/u/underscore/v/x/y/z) -/FontFile 1483 0 R +/FontFile 1508 0 R >> endobj -433 0 obj << +441 0 obj << /Type /Font /Subtype /Type1 /BaseFont /GPIGCD+CMBX10 -/FontDescriptor 1454 0 R +/FontDescriptor 1479 0 R /FirstChar 12 /LastChar 124 -/Widths 1450 0 R +/Widths 1475 0 R >> endobj -431 0 obj << +439 0 obj << /Type /Font /Subtype /Type1 /BaseFont /GBHFLB+CMBX12 -/FontDescriptor 1456 0 R +/FontDescriptor 1481 0 R /FirstChar 12 /LastChar 124 -/Widths 1452 0 R +/Widths 1477 0 R >> endobj -587 0 obj << +597 0 obj << /Type /Font /Subtype /Type1 /BaseFont /XOPWSZ+CMMI10 -/FontDescriptor 1458 0 R +/FontDescriptor 1483 0 R /FirstChar 11 /LastChar 122 -/Widths 1447 0 R +/Widths 1472 0 R >> endobj -634 0 obj << +644 0 obj << /Type /Font /Subtype /Type1 /BaseFont /RVPZIX+CMMI5 -/FontDescriptor 1460 0 R +/FontDescriptor 1485 0 R /FirstChar 105 /LastChar 105 -/Widths 1440 0 R +/Widths 1465 0 R >> endobj -603 0 obj << +613 0 obj << /Type /Font /Subtype /Type1 /BaseFont /LUIBYK+CMMI7 -/FontDescriptor 1462 0 R +/FontDescriptor 1487 0 R /FirstChar 59 /LastChar 114 -/Widths 1444 0 R +/Widths 1469 0 R >> endobj -434 0 obj << +442 0 obj << /Type /Font /Subtype /Type1 /BaseFont /GHWWVJ+CMR10 -/FontDescriptor 1464 0 R +/FontDescriptor 1489 0 R /FirstChar 11 /LastChar 123 -/Widths 1449 0 R +/Widths 1474 0 R >> endobj -605 0 obj << +615 0 obj << /Type /Font /Subtype /Type1 /BaseFont /YPSQTS+CMR6 -/FontDescriptor 1466 0 R +/FontDescriptor 1491 0 R /FirstChar 49 /LastChar 51 -/Widths 1442 0 R +/Widths 1467 0 R >> endobj -602 0 obj << +612 0 obj << /Type /Font /Subtype /Type1 /BaseFont /EWABFK+CMR7 -/FontDescriptor 1468 0 R +/FontDescriptor 1493 0 R /FirstChar 49 /LastChar 58 -/Widths 1445 0 R +/Widths 1470 0 R >> endobj -607 0 obj << +617 0 obj << /Type /Font /Subtype /Type1 /BaseFont /TDRORS+CMR8 -/FontDescriptor 1470 0 R +/FontDescriptor 1495 0 R /FirstChar 40 /LastChar 121 -/Widths 1441 0 R +/Widths 1466 0 R >> endobj -927 0 obj << +953 0 obj << /Type /Font /Subtype /Type1 /BaseFont /HLSVSX+CMR9 -/FontDescriptor 1472 0 R +/FontDescriptor 1497 0 R /FirstChar 40 /LastChar 115 -/Widths 1437 0 R +/Widths 1462 0 R >> endobj -604 0 obj << +614 0 obj << /Type /Font /Subtype /Type1 /BaseFont /IMOIOS+CMSY10 -/FontDescriptor 1474 0 R +/FontDescriptor 1499 0 R /FirstChar 0 /LastChar 120 -/Widths 1443 0 R +/Widths 1468 0 R >> endobj -851 0 obj << +876 0 obj << /Type /Font /Subtype /Type1 /BaseFont /XNLILI+CMSY7 -/FontDescriptor 1476 0 R +/FontDescriptor 1501 0 R /FirstChar 0 /LastChar 49 -/Widths 1438 0 R +/Widths 1463 0 R >> endobj -573 0 obj << +583 0 obj << /Type /Font /Subtype /Type1 /BaseFont /HMYRPA+CMTI10 -/FontDescriptor 1478 0 R +/FontDescriptor 1503 0 R /FirstChar 11 /LastChar 121 -/Widths 1448 0 R +/Widths 1473 0 R >> endobj -432 0 obj << +440 0 obj << /Type /Font /Subtype /Type1 /BaseFont /OZJPZO+CMTI12 -/FontDescriptor 1480 0 R +/FontDescriptor 1505 0 R /FirstChar 65 /LastChar 121 -/Widths 1451 0 R +/Widths 1476 0 R >> endobj -601 0 obj << +611 0 obj << /Type /Font /Subtype /Type1 -/BaseFont /WZDMKI+CMTT10 -/FontDescriptor 1482 0 R -/FirstChar 38 +/BaseFont /ATJOAU+CMTT10 +/FontDescriptor 1507 0 R +/FirstChar 37 /LastChar 126 -/Widths 1446 0 R +/Widths 1471 0 R >> endobj -726 0 obj << +756 0 obj << /Type /Font /Subtype /Type1 /BaseFont /LEILHS+CMTT9 -/FontDescriptor 1484 0 R +/FontDescriptor 1509 0 R /FirstChar 39 /LastChar 122 -/Widths 1439 0 R +/Widths 1464 0 R >> endobj -435 0 obj << +443 0 obj << /Type /Pages /Count 6 -/Parent 1485 0 R -/Kids [426 0 R 437 0 R 485 0 R 536 0 R 554 0 R 558 0 R] +/Parent 1510 0 R +/Kids [434 0 R 445 0 R 493 0 R 546 0 R 564 0 R 568 0 R] >> endobj -574 0 obj << +584 0 obj << /Type /Pages /Count 6 -/Parent 1485 0 R -/Kids [571 0 R 585 0 R 598 0 R 614 0 R 627 0 R 631 0 R] +/Parent 1510 0 R +/Kids [581 0 R 595 0 R 608 0 R 624 0 R 637 0 R 641 0 R] >> endobj -660 0 obj << +670 0 obj << /Type /Pages /Count 6 -/Parent 1485 0 R -/Kids [644 0 R 663 0 R 669 0 R 679 0 R 693 0 R 699 0 R] +/Parent 1510 0 R +/Kids [654 0 R 673 0 R 679 0 R 689 0 R 703 0 R 709 0 R] >> endobj -711 0 obj << +722 0 obj << /Type /Pages /Count 6 -/Parent 1485 0 R -/Kids [708 0 R 716 0 R 723 0 R 732 0 R 737 0 R 743 0 R] +/Parent 1510 0 R +/Kids [718 0 R 724 0 R 730 0 R 738 0 R 746 0 R 753 0 R] >> endobj -751 0 obj << +764 0 obj << /Type /Pages /Count 6 -/Parent 1485 0 R -/Kids [747 0 R 753 0 R 763 0 R 768 0 R 776 0 R 781 0 R] +/Parent 1510 0 R +/Kids [761 0 R 768 0 R 773 0 R 778 0 R 788 0 R 793 0 R] >> endobj -793 0 obj << +805 0 obj << /Type /Pages /Count 6 -/Parent 1485 0 R -/Kids [789 0 R 795 0 R 801 0 R 808 0 R 815 0 R 822 0 R] +/Parent 1510 0 R +/Kids [801 0 R 807 0 R 815 0 R 820 0 R 826 0 R 833 0 R] >> endobj -830 0 obj << +844 0 obj << /Type /Pages /Count 6 -/Parent 1486 0 R -/Kids [827 0 R 834 0 R 841 0 R 848 0 R 858 0 R 872 0 R] +/Parent 1511 0 R +/Kids [840 0 R 848 0 R 853 0 R 859 0 R 866 0 R 873 0 R] >> endobj -882 0 obj << +890 0 obj << /Type /Pages /Count 6 -/Parent 1486 0 R -/Kids [878 0 R 888 0 R 894 0 R 899 0 R 906 0 R 914 0 R] +/Parent 1511 0 R +/Kids [883 0 R 898 0 R 904 0 R 913 0 R 919 0 R 924 0 R] >> endobj -928 0 obj << +935 0 obj << /Type /Pages /Count 6 -/Parent 1486 0 R -/Kids [924 0 R 932 0 R 941 0 R 949 0 R 953 0 R 964 0 R] +/Parent 1511 0 R +/Kids [931 0 R 940 0 R 950 0 R 957 0 R 966 0 R 974 0 R] >> endobj -972 0 obj << +981 0 obj << /Type /Pages /Count 6 -/Parent 1486 0 R -/Kids [969 0 R 976 0 R 981 0 R 985 0 R 990 0 R 995 0 R] +/Parent 1511 0 R +/Kids [978 0 R 990 0 R 995 0 R 1001 0 R 1006 0 R 1010 0 R] >> endobj -1008 0 obj << +1019 0 obj << /Type /Pages /Count 6 -/Parent 1486 0 R -/Kids [1004 0 R 1011 0 R 1019 0 R 1026 0 R 1031 0 R 1037 0 R] +/Parent 1511 0 R +/Kids [1015 0 R 1021 0 R 1030 0 R 1036 0 R 1044 0 R 1051 0 R] >> endobj -1046 0 obj << +1059 0 obj << /Type /Pages /Count 6 -/Parent 1486 0 R -/Kids [1041 0 R 1050 0 R 1060 0 R 1064 0 R 1076 0 R 1082 0 R] +/Parent 1511 0 R +/Kids [1056 0 R 1063 0 R 1067 0 R 1075 0 R 1085 0 R 1089 0 R] >> endobj -1094 0 obj << +1106 0 obj << /Type /Pages /Count 6 -/Parent 1487 0 R -/Kids [1091 0 R 1098 0 R 1104 0 R 1109 0 R 1113 0 R 1120 0 R] +/Parent 1512 0 R +/Kids [1101 0 R 1108 0 R 1117 0 R 1123 0 R 1129 0 R 1134 0 R] >> endobj -1128 0 obj << +1143 0 obj << /Type /Pages /Count 6 -/Parent 1487 0 R -/Kids [1125 0 R 1130 0 R 1135 0 R 1139 0 R 1146 0 R 1151 0 R] +/Parent 1512 0 R +/Kids [1138 0 R 1146 0 R 1151 0 R 1155 0 R 1160 0 R 1164 0 R] >> endobj -1161 0 obj << +1174 0 obj << /Type /Pages /Count 6 -/Parent 1487 0 R -/Kids [1157 0 R 1164 0 R 1170 0 R 1176 0 R 1183 0 R 1190 0 R] +/Parent 1512 0 R +/Kids [1171 0 R 1177 0 R 1183 0 R 1189 0 R 1195 0 R 1201 0 R] >> endobj -1200 0 obj << +1213 0 obj << /Type /Pages /Count 6 -/Parent 1487 0 R -/Kids [1194 0 R 1205 0 R 1209 0 R 1213 0 R 1226 0 R 1230 0 R] +/Parent 1512 0 R +/Kids [1208 0 R 1216 0 R 1220 0 R 1230 0 R 1234 0 R 1238 0 R] >> endobj -1241 0 obj << +1254 0 obj << /Type /Pages /Count 6 -/Parent 1487 0 R -/Kids [1236 0 R 1243 0 R 1250 0 R 1254 0 R 1258 0 R 1262 0 R] +/Parent 1512 0 R +/Kids [1251 0 R 1256 0 R 1262 0 R 1268 0 R 1275 0 R 1279 0 R] >> endobj -1269 0 obj << +1286 0 obj << /Type /Pages /Count 6 -/Parent 1487 0 R -/Kids [1266 0 R 1271 0 R 1275 0 R 1281 0 R 1287 0 R 1293 0 R] +/Parent 1512 0 R +/Kids [1283 0 R 1288 0 R 1292 0 R 1296 0 R 1300 0 R 1306 0 R] >> endobj -1304 0 obj << +1317 0 obj << /Type /Pages /Count 6 -/Parent 1488 0 R -/Kids [1299 0 R 1306 0 R 1311 0 R 1318 0 R 1324 0 R 1328 0 R] +/Parent 1513 0 R +/Kids [1312 0 R 1319 0 R 1325 0 R 1331 0 R 1336 0 R 1343 0 R] >> endobj -1335 0 obj << +1352 0 obj << /Type /Pages /Count 6 -/Parent 1488 0 R -/Kids [1332 0 R 1337 0 R 1341 0 R 1345 0 R 1350 0 R 1355 0 R] +/Parent 1513 0 R +/Kids [1349 0 R 1354 0 R 1358 0 R 1362 0 R 1366 0 R 1370 0 R] >> endobj -1363 0 obj << +1378 0 obj << /Type /Pages /Count 6 -/Parent 1488 0 R -/Kids [1360 0 R 1365 0 R 1370 0 R 1374 0 R 1380 0 R 1389 0 R] +/Parent 1513 0 R +/Kids [1375 0 R 1381 0 R 1386 0 R 1390 0 R 1395 0 R 1399 0 R] >> endobj -1398 0 obj << +1409 0 obj << /Type /Pages /Count 6 -/Parent 1488 0 R -/Kids [1395 0 R 1401 0 R 1405 0 R 1411 0 R 1416 0 R 1420 0 R] +/Parent 1513 0 R +/Kids [1405 0 R 1415 0 R 1421 0 R 1426 0 R 1430 0 R 1436 0 R] >> endobj -1431 0 obj << +1444 0 obj << /Type /Pages -/Count 2 -/Parent 1488 0 R -/Kids [1424 0 R 1433 0 R] +/Count 4 +/Parent 1513 0 R +/Kids [1441 0 R 1446 0 R 1450 0 R 1458 0 R] >> endobj -1485 0 obj << +1510 0 obj << /Type /Pages /Count 36 -/Parent 1489 0 R -/Kids [435 0 R 574 0 R 660 0 R 711 0 R 751 0 R 793 0 R] +/Parent 1514 0 R +/Kids [443 0 R 584 0 R 670 0 R 722 0 R 764 0 R 805 0 R] >> endobj -1486 0 obj << +1511 0 obj << /Type /Pages /Count 36 -/Parent 1489 0 R -/Kids [830 0 R 882 0 R 928 0 R 972 0 R 1008 0 R 1046 0 R] +/Parent 1514 0 R +/Kids [844 0 R 890 0 R 935 0 R 981 0 R 1019 0 R 1059 0 R] >> endobj -1487 0 obj << +1512 0 obj << /Type /Pages /Count 36 -/Parent 1489 0 R -/Kids [1094 0 R 1128 0 R 1161 0 R 1200 0 R 1241 0 R 1269 0 R] +/Parent 1514 0 R +/Kids [1106 0 R 1143 0 R 1174 0 R 1213 0 R 1254 0 R 1286 0 R] >> endobj -1488 0 obj << +1513 0 obj << /Type /Pages -/Count 26 -/Parent 1489 0 R -/Kids [1304 0 R 1335 0 R 1363 0 R 1398 0 R 1431 0 R] +/Count 28 +/Parent 1514 0 R +/Kids [1317 0 R 1352 0 R 1378 0 R 1409 0 R 1444 0 R] >> endobj -1489 0 obj << +1514 0 obj << /Type /Pages -/Count 134 -/Kids [1485 0 R 1486 0 R 1487 0 R 1488 0 R] +/Count 136 +/Kids [1510 0 R 1511 0 R 1512 0 R 1513 0 R] >> endobj -1490 0 obj << +1515 0 obj << /Type /Outlines /First 7 0 R /Last 7 0 R /Count 1 >> endobj +431 0 obj << +/Title 432 0 R +/A 429 0 R +/Parent 427 0 R +>> endobj +427 0 obj << +/Title 428 0 R +/A 425 0 R +/Parent 7 0 R +/Prev 407 0 R +/First 431 0 R +/Last 431 0 R +/Count -1 +>> endobj 423 0 obj << /Title 424 0 R /A 421 0 R -/Parent 419 0 R +/Parent 407 0 R +/Prev 419 0 R >> endobj 419 0 obj << /Title 420 0 R /A 417 0 R -/Parent 7 0 R -/Prev 399 0 R -/First 423 0 R -/Last 423 0 R -/Count -1 +/Parent 407 0 R +/Prev 415 0 R +/Next 423 0 R >> endobj 415 0 obj << /Title 416 0 R /A 413 0 R -/Parent 399 0 R +/Parent 407 0 R /Prev 411 0 R +/Next 419 0 R >> endobj 411 0 obj << /Title 412 0 R /A 409 0 R -/Parent 399 0 R -/Prev 407 0 R +/Parent 407 0 R /Next 415 0 R >> endobj 407 0 obj << /Title 408 0 R /A 405 0 R -/Parent 399 0 R -/Prev 403 0 R -/Next 411 0 R +/Parent 7 0 R +/Prev 383 0 R +/Next 427 0 R +/First 411 0 R +/Last 423 0 R +/Count -4 >> endobj 403 0 obj << /Title 404 0 R /A 401 0 R -/Parent 399 0 R -/Next 407 0 R +/Parent 387 0 R +/Prev 399 0 R >> endobj 399 0 obj << /Title 400 0 R /A 397 0 R -/Parent 7 0 R -/Prev 375 0 R -/Next 419 0 R -/First 403 0 R -/Last 415 0 R -/Count -4 +/Parent 387 0 R +/Prev 395 0 R +/Next 403 0 R >> endobj 395 0 obj << /Title 396 0 R /A 393 0 R -/Parent 379 0 R +/Parent 387 0 R /Prev 391 0 R +/Next 399 0 R >> endobj 391 0 obj << /Title 392 0 R /A 389 0 R -/Parent 379 0 R -/Prev 387 0 R +/Parent 387 0 R /Next 395 0 R >> endobj 387 0 obj << /Title 388 0 R /A 385 0 R -/Parent 379 0 R -/Prev 383 0 R -/Next 391 0 R +/Parent 383 0 R +/First 391 0 R +/Last 403 0 R +/Count -4 >> endobj 383 0 obj << /Title 384 0 R /A 381 0 R -/Parent 379 0 R -/Next 387 0 R +/Parent 7 0 R +/Prev 363 0 R +/Next 407 0 R +/First 387 0 R +/Last 387 0 R +/Count -1 >> endobj 379 0 obj << /Title 380 0 R /A 377 0 R -/Parent 375 0 R -/First 383 0 R -/Last 395 0 R -/Count -4 +/Parent 363 0 R +/Prev 375 0 R >> endobj 375 0 obj << /Title 376 0 R /A 373 0 R -/Parent 7 0 R -/Prev 355 0 R -/Next 399 0 R -/First 379 0 R -/Last 379 0 R -/Count -1 +/Parent 363 0 R +/Prev 371 0 R +/Next 379 0 R >> endobj 371 0 obj << /Title 372 0 R /A 369 0 R -/Parent 355 0 R +/Parent 363 0 R /Prev 367 0 R +/Next 375 0 R >> endobj 367 0 obj << /Title 368 0 R /A 365 0 R -/Parent 355 0 R -/Prev 363 0 R +/Parent 363 0 R /Next 371 0 R >> endobj 363 0 obj << /Title 364 0 R /A 361 0 R -/Parent 355 0 R -/Prev 359 0 R -/Next 367 0 R +/Parent 7 0 R +/Prev 295 0 R +/Next 383 0 R +/First 367 0 R +/Last 379 0 R +/Count -4 >> endobj 359 0 obj << /Title 360 0 R /A 357 0 R -/Parent 355 0 R -/Next 363 0 R +/Parent 295 0 R +/Prev 355 0 R >> endobj 355 0 obj << /Title 356 0 R /A 353 0 R -/Parent 7 0 R -/Prev 287 0 R -/Next 375 0 R -/First 359 0 R -/Last 371 0 R -/Count -4 +/Parent 295 0 R +/Prev 351 0 R +/Next 359 0 R >> endobj 351 0 obj << /Title 352 0 R /A 349 0 R -/Parent 287 0 R +/Parent 295 0 R /Prev 347 0 R +/Next 355 0 R >> endobj 347 0 obj << /Title 348 0 R /A 345 0 R -/Parent 287 0 R +/Parent 295 0 R /Prev 343 0 R /Next 351 0 R >> endobj 343 0 obj << /Title 344 0 R /A 341 0 R -/Parent 287 0 R +/Parent 295 0 R /Prev 339 0 R /Next 347 0 R >> endobj 339 0 obj << /Title 340 0 R /A 337 0 R -/Parent 287 0 R +/Parent 295 0 R /Prev 335 0 R /Next 343 0 R >> endobj 335 0 obj << /Title 336 0 R /A 333 0 R -/Parent 287 0 R +/Parent 295 0 R /Prev 331 0 R /Next 339 0 R >> endobj 331 0 obj << /Title 332 0 R /A 329 0 R -/Parent 287 0 R +/Parent 295 0 R /Prev 327 0 R /Next 335 0 R >> endobj 327 0 obj << /Title 328 0 R /A 325 0 R -/Parent 287 0 R +/Parent 295 0 R /Prev 323 0 R /Next 331 0 R >> endobj 323 0 obj << /Title 324 0 R /A 321 0 R -/Parent 287 0 R +/Parent 295 0 R /Prev 319 0 R /Next 327 0 R >> endobj 319 0 obj << /Title 320 0 R /A 317 0 R -/Parent 287 0 R +/Parent 295 0 R /Prev 315 0 R /Next 323 0 R >> endobj 315 0 obj << /Title 316 0 R /A 313 0 R -/Parent 287 0 R +/Parent 295 0 R /Prev 311 0 R /Next 319 0 R >> endobj 311 0 obj << /Title 312 0 R /A 309 0 R -/Parent 287 0 R +/Parent 295 0 R /Prev 307 0 R /Next 315 0 R >> endobj 307 0 obj << /Title 308 0 R /A 305 0 R -/Parent 287 0 R +/Parent 295 0 R /Prev 303 0 R /Next 311 0 R >> endobj 303 0 obj << /Title 304 0 R /A 301 0 R -/Parent 287 0 R +/Parent 295 0 R /Prev 299 0 R /Next 307 0 R >> endobj 299 0 obj << /Title 300 0 R /A 297 0 R -/Parent 287 0 R -/Prev 295 0 R +/Parent 295 0 R /Next 303 0 R >> endobj 295 0 obj << /Title 296 0 R /A 293 0 R -/Parent 287 0 R -/Prev 291 0 R -/Next 299 0 R +/Parent 7 0 R +/Prev 183 0 R +/Next 363 0 R +/First 299 0 R +/Last 359 0 R +/Count -16 >> endobj 291 0 obj << /Title 292 0 R /A 289 0 R -/Parent 287 0 R -/Next 295 0 R +/Parent 183 0 R +/Prev 287 0 R >> endobj 287 0 obj << /Title 288 0 R /A 285 0 R -/Parent 7 0 R -/Prev 175 0 R -/Next 355 0 R -/First 291 0 R -/Last 351 0 R -/Count -16 +/Parent 183 0 R +/Prev 283 0 R +/Next 291 0 R >> endobj 283 0 obj << /Title 284 0 R /A 281 0 R -/Parent 175 0 R +/Parent 183 0 R /Prev 279 0 R +/Next 287 0 R >> endobj 279 0 obj << /Title 280 0 R /A 277 0 R -/Parent 175 0 R +/Parent 183 0 R /Prev 275 0 R /Next 283 0 R >> endobj 275 0 obj << /Title 276 0 R /A 273 0 R -/Parent 175 0 R +/Parent 183 0 R /Prev 271 0 R /Next 279 0 R >> endobj 271 0 obj << /Title 272 0 R /A 269 0 R -/Parent 175 0 R +/Parent 183 0 R /Prev 267 0 R /Next 275 0 R >> endobj 267 0 obj << /Title 268 0 R /A 265 0 R -/Parent 175 0 R +/Parent 183 0 R /Prev 263 0 R /Next 271 0 R >> endobj 263 0 obj << /Title 264 0 R /A 261 0 R -/Parent 175 0 R +/Parent 183 0 R /Prev 259 0 R /Next 267 0 R >> endobj 259 0 obj << /Title 260 0 R /A 257 0 R -/Parent 175 0 R +/Parent 183 0 R /Prev 255 0 R /Next 263 0 R >> endobj 255 0 obj << /Title 256 0 R /A 253 0 R -/Parent 175 0 R +/Parent 183 0 R /Prev 251 0 R /Next 259 0 R >> endobj 251 0 obj << /Title 252 0 R /A 249 0 R -/Parent 175 0 R +/Parent 183 0 R /Prev 247 0 R /Next 255 0 R >> endobj 247 0 obj << /Title 248 0 R /A 245 0 R -/Parent 175 0 R +/Parent 183 0 R /Prev 243 0 R /Next 251 0 R >> endobj 243 0 obj << /Title 244 0 R /A 241 0 R -/Parent 175 0 R +/Parent 183 0 R /Prev 239 0 R /Next 247 0 R >> endobj 239 0 obj << /Title 240 0 R /A 237 0 R -/Parent 175 0 R +/Parent 183 0 R /Prev 235 0 R /Next 243 0 R >> endobj 235 0 obj << /Title 236 0 R /A 233 0 R -/Parent 175 0 R +/Parent 183 0 R /Prev 231 0 R /Next 239 0 R >> endobj 231 0 obj << /Title 232 0 R /A 229 0 R -/Parent 175 0 R +/Parent 183 0 R /Prev 227 0 R /Next 235 0 R >> endobj 227 0 obj << /Title 228 0 R /A 225 0 R -/Parent 175 0 R +/Parent 183 0 R /Prev 223 0 R /Next 231 0 R >> endobj 223 0 obj << /Title 224 0 R /A 221 0 R -/Parent 175 0 R +/Parent 183 0 R /Prev 219 0 R /Next 227 0 R >> endobj 219 0 obj << /Title 220 0 R /A 217 0 R -/Parent 175 0 R +/Parent 183 0 R /Prev 215 0 R /Next 223 0 R >> endobj 215 0 obj << /Title 216 0 R /A 213 0 R -/Parent 175 0 R +/Parent 183 0 R /Prev 211 0 R /Next 219 0 R >> endobj 211 0 obj << /Title 212 0 R /A 209 0 R -/Parent 175 0 R +/Parent 183 0 R /Prev 207 0 R /Next 215 0 R >> endobj 207 0 obj << /Title 208 0 R /A 205 0 R -/Parent 175 0 R +/Parent 183 0 R /Prev 203 0 R /Next 211 0 R >> endobj 203 0 obj << /Title 204 0 R /A 201 0 R -/Parent 175 0 R +/Parent 183 0 R /Prev 199 0 R /Next 207 0 R >> endobj 199 0 obj << /Title 200 0 R /A 197 0 R -/Parent 175 0 R +/Parent 183 0 R /Prev 195 0 R /Next 203 0 R >> endobj 195 0 obj << /Title 196 0 R /A 193 0 R -/Parent 175 0 R +/Parent 183 0 R /Prev 191 0 R /Next 199 0 R >> endobj 191 0 obj << /Title 192 0 R /A 189 0 R -/Parent 175 0 R +/Parent 183 0 R /Prev 187 0 R /Next 195 0 R >> endobj 187 0 obj << /Title 188 0 R /A 185 0 R -/Parent 175 0 R -/Prev 183 0 R +/Parent 183 0 R /Next 191 0 R >> endobj 183 0 obj << /Title 184 0 R /A 181 0 R -/Parent 175 0 R -/Prev 179 0 R -/Next 187 0 R +/Parent 7 0 R +/Prev 163 0 R +/Next 295 0 R +/First 187 0 R +/Last 291 0 R +/Count -27 >> endobj 179 0 obj << /Title 180 0 R /A 177 0 R -/Parent 175 0 R -/Next 183 0 R +/Parent 163 0 R +/Prev 175 0 R >> endobj 175 0 obj << /Title 176 0 R /A 173 0 R -/Parent 7 0 R -/Prev 155 0 R -/Next 287 0 R -/First 179 0 R -/Last 283 0 R -/Count -27 +/Parent 163 0 R +/Prev 171 0 R +/Next 179 0 R >> endobj 171 0 obj << /Title 172 0 R /A 169 0 R -/Parent 155 0 R +/Parent 163 0 R /Prev 167 0 R +/Next 175 0 R >> endobj 167 0 obj << /Title 168 0 R /A 165 0 R -/Parent 155 0 R -/Prev 163 0 R +/Parent 163 0 R /Next 171 0 R >> endobj 163 0 obj << /Title 164 0 R /A 161 0 R -/Parent 155 0 R -/Prev 159 0 R -/Next 167 0 R +/Parent 7 0 R +/Prev 111 0 R +/Next 183 0 R +/First 167 0 R +/Last 179 0 R +/Count -4 >> endobj 159 0 obj << /Title 160 0 R /A 157 0 R -/Parent 155 0 R -/Next 163 0 R +/Parent 111 0 R +/Prev 155 0 R >> endobj 155 0 obj << /Title 156 0 R /A 153 0 R -/Parent 7 0 R -/Prev 103 0 R -/Next 175 0 R -/First 159 0 R -/Last 171 0 R -/Count -4 +/Parent 111 0 R +/Prev 151 0 R +/Next 159 0 R >> endobj 151 0 obj << /Title 152 0 R /A 149 0 R -/Parent 103 0 R +/Parent 111 0 R /Prev 147 0 R +/Next 155 0 R >> endobj 147 0 obj << /Title 148 0 R /A 145 0 R -/Parent 103 0 R +/Parent 111 0 R /Prev 143 0 R /Next 151 0 R >> endobj 143 0 obj << /Title 144 0 R /A 141 0 R -/Parent 103 0 R +/Parent 111 0 R /Prev 139 0 R /Next 147 0 R >> endobj 139 0 obj << /Title 140 0 R /A 137 0 R -/Parent 103 0 R +/Parent 111 0 R /Prev 135 0 R /Next 143 0 R >> endobj 135 0 obj << /Title 136 0 R /A 133 0 R -/Parent 103 0 R +/Parent 111 0 R /Prev 131 0 R /Next 139 0 R >> endobj 131 0 obj << /Title 132 0 R /A 129 0 R -/Parent 103 0 R +/Parent 111 0 R /Prev 127 0 R /Next 135 0 R >> endobj 127 0 obj << /Title 128 0 R /A 125 0 R -/Parent 103 0 R +/Parent 111 0 R /Prev 123 0 R /Next 131 0 R >> endobj 123 0 obj << /Title 124 0 R /A 121 0 R -/Parent 103 0 R +/Parent 111 0 R /Prev 119 0 R /Next 127 0 R >> endobj 119 0 obj << /Title 120 0 R /A 117 0 R -/Parent 103 0 R +/Parent 111 0 R /Prev 115 0 R /Next 123 0 R >> endobj 115 0 obj << /Title 116 0 R /A 113 0 R -/Parent 103 0 R -/Prev 111 0 R +/Parent 111 0 R /Next 119 0 R >> endobj 111 0 obj << /Title 112 0 R /A 109 0 R -/Parent 103 0 R -/Prev 107 0 R -/Next 115 0 R +/Parent 7 0 R +/Prev 35 0 R +/Next 163 0 R +/First 115 0 R +/Last 159 0 R +/Count -12 >> endobj 107 0 obj << /Title 108 0 R /A 105 0 R -/Parent 103 0 R -/Next 111 0 R +/Parent 67 0 R +/Prev 103 0 R >> endobj 103 0 obj << /Title 104 0 R /A 101 0 R -/Parent 7 0 R -/Prev 35 0 R -/Next 155 0 R -/First 107 0 R -/Last 151 0 R -/Count -12 +/Parent 67 0 R +/Prev 99 0 R +/Next 107 0 R >> endobj 99 0 obj << /Title 100 0 R /A 97 0 R -/Parent 59 0 R +/Parent 67 0 R /Prev 95 0 R +/Next 103 0 R >> endobj 95 0 obj << /Title 96 0 R /A 93 0 R -/Parent 59 0 R +/Parent 67 0 R /Prev 91 0 R /Next 99 0 R >> endobj 91 0 obj << /Title 92 0 R /A 89 0 R -/Parent 59 0 R +/Parent 67 0 R /Prev 87 0 R /Next 95 0 R >> endobj 87 0 obj << /Title 88 0 R /A 85 0 R -/Parent 59 0 R +/Parent 67 0 R /Prev 83 0 R /Next 91 0 R >> endobj 83 0 obj << /Title 84 0 R /A 81 0 R -/Parent 59 0 R +/Parent 67 0 R /Prev 79 0 R /Next 87 0 R >> endobj 79 0 obj << /Title 80 0 R /A 77 0 R -/Parent 59 0 R +/Parent 67 0 R /Prev 75 0 R /Next 83 0 R >> endobj 75 0 obj << /Title 76 0 R /A 73 0 R -/Parent 59 0 R +/Parent 67 0 R /Prev 71 0 R /Next 79 0 R >> endobj 71 0 obj << /Title 72 0 R /A 69 0 R -/Parent 59 0 R -/Prev 67 0 R +/Parent 67 0 R /Next 75 0 R >> endobj 67 0 obj << /Title 68 0 R /A 65 0 R -/Parent 59 0 R +/Parent 35 0 R /Prev 63 0 R -/Next 71 0 R +/First 71 0 R +/Last 107 0 R +/Count -10 >> endobj 63 0 obj << /Title 64 0 R /A 61 0 R -/Parent 59 0 R +/Parent 35 0 R +/Prev 55 0 R /Next 67 0 R >> endobj 59 0 obj << /Title 60 0 R /A 57 0 R -/Parent 35 0 R -/Prev 55 0 R -/First 63 0 R -/Last 99 0 R -/Count -10 +/Parent 55 0 R >> endobj 55 0 obj << /Title 56 0 R /A 53 0 R /Parent 35 0 R /Prev 47 0 R -/Next 59 0 R +/Next 63 0 R +/First 59 0 R +/Last 59 0 R +/Count -1 >> endobj 51 0 obj << /Title 52 0 R @@ -19895,10 +20148,10 @@ endobj /A 33 0 R /Parent 7 0 R /Prev 15 0 R -/Next 103 0 R +/Next 111 0 R /First 39 0 R -/Last 59 0 R -/Count -4 +/Last 67 0 R +/Count -5 >> endobj 31 0 obj << /Title 32 0 R @@ -19945,1940 +20198,1975 @@ endobj 7 0 obj << /Title 8 0 R /A 5 0 R -/Parent 1490 0 R +/Parent 1515 0 R /First 11 0 R -/Last 419 0 R +/Last 427 0 R /Count -11 >> endobj -1491 0 obj << -/Names [(Doc-Start) 430 0 R (Hfootnote.1) 606 0 R (Hfootnote.2) 608 0 R (Hfootnote.3) 1383 0 R (Item.1) 635 0 R (Item.10) 648 0 R] +1516 0 obj << +/Names [(Doc-Start) 438 0 R (Hfootnote.1) 616 0 R (Hfootnote.2) 618 0 R (Hfootnote.3) 1408 0 R (Item.1) 645 0 R (Item.10) 658 0 R] /Limits [(Doc-Start) (Item.10)] >> endobj -1492 0 obj << -/Names [(Item.100) 1248 0 R (Item.101) 1278 0 R (Item.102) 1279 0 R (Item.103) 1284 0 R (Item.104) 1285 0 R (Item.105) 1290 0 R] +1517 0 obj << +/Names [(Item.100) 1265 0 R (Item.101) 1266 0 R (Item.102) 1271 0 R (Item.103) 1272 0 R (Item.104) 1273 0 R (Item.105) 1303 0 R] /Limits [(Item.100) (Item.105)] >> endobj -1493 0 obj << -/Names [(Item.106) 1291 0 R (Item.107) 1296 0 R (Item.108) 1297 0 R (Item.109) 1302 0 R (Item.11) 649 0 R (Item.110) 1303 0 R] +1518 0 obj << +/Names [(Item.106) 1304 0 R (Item.107) 1309 0 R (Item.108) 1310 0 R (Item.109) 1315 0 R (Item.11) 659 0 R (Item.110) 1316 0 R] /Limits [(Item.106) (Item.110)] >> endobj -1494 0 obj << -/Names [(Item.111) 1309 0 R (Item.112) 1314 0 R (Item.12) 650 0 R (Item.13) 651 0 R (Item.14) 652 0 R (Item.15) 653 0 R] -/Limits [(Item.111) (Item.15)] ->> endobj -1495 0 obj << -/Names [(Item.16) 654 0 R (Item.17) 655 0 R (Item.18) 656 0 R (Item.19) 657 0 R (Item.2) 636 0 R (Item.20) 658 0 R] -/Limits [(Item.16) (Item.20)] ->> endobj -1496 0 obj << -/Names [(Item.21) 659 0 R (Item.22) 673 0 R (Item.23) 674 0 R (Item.24) 675 0 R (Item.25) 676 0 R (Item.26) 677 0 R] -/Limits [(Item.21) (Item.26)] ->> endobj -1497 0 obj << -/Names [(Item.27) 682 0 R (Item.28) 683 0 R (Item.29) 684 0 R (Item.3) 637 0 R (Item.30) 685 0 R (Item.31) 686 0 R] -/Limits [(Item.27) (Item.31)] ->> endobj -1498 0 obj << -/Names [(Item.32) 687 0 R (Item.33) 688 0 R (Item.34) 689 0 R (Item.35) 702 0 R (Item.36) 703 0 R (Item.37) 704 0 R] -/Limits [(Item.32) (Item.37)] ->> endobj -1499 0 obj << -/Names [(Item.38) 705 0 R (Item.39) 750 0 R (Item.4) 638 0 R (Item.40) 944 0 R (Item.41) 945 0 R (Item.42) 946 0 R] -/Limits [(Item.38) (Item.42)] ->> endobj -1500 0 obj << -/Names [(Item.43) 993 0 R (Item.44) 998 0 R (Item.45) 999 0 R (Item.46) 1000 0 R (Item.47) 1001 0 R (Item.48) 1002 0 R] -/Limits [(Item.43) (Item.48)] ->> endobj -1501 0 obj << -/Names [(Item.49) 1007 0 R (Item.5) 639 0 R (Item.50) 1014 0 R (Item.51) 1015 0 R (Item.52) 1022 0 R (Item.53) 1044 0 R] -/Limits [(Item.49) (Item.53)] ->> endobj -1502 0 obj << -/Names [(Item.54) 1045 0 R (Item.55) 1053 0 R (Item.56) 1054 0 R (Item.57) 1055 0 R (Item.58) 1067 0 R (Item.59) 1068 0 R] -/Limits [(Item.54) (Item.59)] ->> endobj -1503 0 obj << -/Names [(Item.6) 640 0 R (Item.60) 1069 0 R (Item.61) 1070 0 R (Item.62) 1071 0 R (Item.63) 1072 0 R (Item.64) 1079 0 R] -/Limits [(Item.6) (Item.64)] ->> endobj -1504 0 obj << -/Names [(Item.65) 1080 0 R (Item.66) 1085 0 R (Item.67) 1086 0 R (Item.68) 1087 0 R (Item.69) 1101 0 R (Item.7) 641 0 R] -/Limits [(Item.65) (Item.7)] ->> endobj -1505 0 obj << -/Names [(Item.70) 1116 0 R (Item.71) 1117 0 R (Item.72) 1142 0 R (Item.73) 1143 0 R (Item.74) 1154 0 R (Item.75) 1160 0 R] -/Limits [(Item.70) (Item.75)] ->> endobj -1506 0 obj << -/Names [(Item.76) 1167 0 R (Item.77) 1173 0 R (Item.78) 1179 0 R (Item.79) 1180 0 R (Item.8) 642 0 R (Item.80) 1186 0 R] -/Limits [(Item.76) (Item.80)] ->> endobj -1507 0 obj << -/Names [(Item.81) 1187 0 R (Item.82) 1197 0 R (Item.83) 1198 0 R (Item.84) 1199 0 R (Item.85) 1216 0 R (Item.86) 1217 0 R] -/Limits [(Item.81) (Item.86)] ->> endobj -1508 0 obj << -/Names [(Item.87) 1218 0 R (Item.88) 1219 0 R (Item.89) 1220 0 R (Item.9) 647 0 R (Item.90) 1221 0 R (Item.91) 1222 0 R] -/Limits [(Item.87) (Item.91)] ->> endobj -1509 0 obj << -/Names [(Item.92) 1223 0 R (Item.93) 1224 0 R (Item.94) 1233 0 R (Item.95) 1234 0 R (Item.96) 1239 0 R (Item.97) 1240 0 R] -/Limits [(Item.92) (Item.97)] ->> endobj -1510 0 obj << -/Names [(Item.98) 1246 0 R (Item.99) 1247 0 R (cite.2007c) 622 0 R (cite.2007d) 623 0 R (cite.BLACS) 593 0 R (cite.BLAS1) 579 0 R] -/Limits [(Item.98) (cite.BLAS1)] ->> endobj -1511 0 obj << -/Names [(cite.BLAS2) 580 0 R (cite.BLAS3) 581 0 R (cite.KIVA3PSBLAS) 1430 0 R (cite.METIS) 609 0 R (cite.MPI1) 1436 0 R (cite.PARA04FOREST) 1428 0 R] -/Limits [(cite.BLAS2) (cite.PARA04FOREST)] ->> endobj -1512 0 obj << -/Names [(cite.PSBLAS) 1429 0 R (cite.machiels) 576 0 R (cite.metcalf) 575 0 R (cite.sblas02) 578 0 R (cite.sblas97) 577 0 R (descdata) 672 0 R] -/Limits [(cite.PSBLAS) (descdata)] ->> endobj -1513 0 obj << -/Names [(equation.1) 861 0 R (equation.2) 862 0 R (equation.3) 863 0 R (figure.1) 588 0 R (figure.2) 617 0 R (figure.3) 690 0 R] -/Limits [(equation.1) (figure.3)] ->> endobj -1514 0 obj << -/Names [(figure.4) 706 0 R (figure.5) 720 0 R (figure.6) 917 0 R (figure.7) 947 0 R (figure.8) 1321 0 R (figure.9) 1322 0 R] -/Limits [(figure.4) (figure.9)] ->> endobj -1515 0 obj << -/Names [(page.1) 429 0 R (page.10) 681 0 R (page.100) 1283 0 R (page.101) 1289 0 R (page.102) 1295 0 R (page.103) 1301 0 R] -/Limits [(page.1) (page.103)] ->> endobj -1516 0 obj << -/Names [(page.104) 1308 0 R (page.105) 1313 0 R (page.106) 1320 0 R (page.107) 1326 0 R (page.108) 1330 0 R (page.109) 1334 0 R] -/Limits [(page.104) (page.109)] ->> endobj -1517 0 obj << -/Names [(page.11) 695 0 R (page.110) 1339 0 R (page.111) 1343 0 R (page.112) 1347 0 R (page.113) 1352 0 R (page.114) 1357 0 R] -/Limits [(page.11) (page.114)] ->> endobj -1518 0 obj << -/Names [(page.115) 1362 0 R (page.116) 1367 0 R (page.117) 1372 0 R (page.118) 1376 0 R (page.119) 1382 0 R (page.12) 701 0 R] -/Limits [(page.115) (page.12)] ->> endobj 1519 0 obj << -/Names [(page.120) 1391 0 R (page.121) 1397 0 R (page.122) 1403 0 R (page.123) 1407 0 R (page.124) 1413 0 R (page.125) 1418 0 R] -/Limits [(page.120) (page.125)] +/Names [(Item.111) 1322 0 R (Item.112) 1323 0 R (Item.113) 1328 0 R (Item.114) 1329 0 R (Item.115) 1334 0 R (Item.116) 1339 0 R] +/Limits [(Item.111) (Item.116)] >> endobj 1520 0 obj << -/Names [(page.126) 1422 0 R (page.127) 1426 0 R (page.128) 1435 0 R (page.13) 710 0 R (page.14) 718 0 R (page.15) 725 0 R] -/Limits [(page.126) (page.15)] +/Names [(Item.12) 660 0 R (Item.13) 661 0 R (Item.14) 662 0 R (Item.15) 663 0 R (Item.16) 664 0 R (Item.17) 665 0 R] +/Limits [(Item.12) (Item.17)] >> endobj 1521 0 obj << -/Names [(page.16) 734 0 R (page.17) 739 0 R (page.18) 745 0 R (page.19) 749 0 R (page.2) 439 0 R (page.20) 755 0 R] -/Limits [(page.16) (page.20)] +/Names [(Item.18) 666 0 R (Item.19) 667 0 R (Item.2) 646 0 R (Item.20) 668 0 R (Item.21) 669 0 R (Item.22) 683 0 R] +/Limits [(Item.18) (Item.22)] >> endobj 1522 0 obj << -/Names [(page.21) 765 0 R (page.22) 770 0 R (page.23) 778 0 R (page.24) 783 0 R (page.25) 791 0 R (page.26) 797 0 R] -/Limits [(page.21) (page.26)] +/Names [(Item.23) 684 0 R (Item.24) 685 0 R (Item.25) 686 0 R (Item.26) 687 0 R (Item.27) 692 0 R (Item.28) 693 0 R] +/Limits [(Item.23) (Item.28)] >> endobj 1523 0 obj << -/Names [(page.27) 803 0 R (page.28) 810 0 R (page.29) 817 0 R (page.3) 600 0 R (page.30) 824 0 R (page.31) 829 0 R] -/Limits [(page.27) (page.31)] +/Names [(Item.29) 694 0 R (Item.3) 647 0 R (Item.30) 695 0 R (Item.31) 696 0 R (Item.32) 697 0 R (Item.33) 698 0 R] +/Limits [(Item.29) (Item.33)] >> endobj 1524 0 obj << -/Names [(page.32) 836 0 R (page.33) 843 0 R (page.34) 850 0 R (page.35) 860 0 R (page.36) 874 0 R (page.37) 880 0 R] -/Limits [(page.32) (page.37)] +/Names [(Item.34) 699 0 R (Item.35) 712 0 R (Item.36) 713 0 R (Item.37) 714 0 R (Item.38) 715 0 R (Item.39) 733 0 R] +/Limits [(Item.34) (Item.39)] >> endobj 1525 0 obj << -/Names [(page.38) 890 0 R (page.39) 896 0 R (page.4) 616 0 R (page.40) 901 0 R (page.41) 908 0 R (page.42) 916 0 R] -/Limits [(page.38) (page.42)] +/Names [(Item.4) 648 0 R (Item.40) 734 0 R (Item.41) 735 0 R (Item.42) 736 0 R (Item.43) 776 0 R (Item.44) 969 0 R] +/Limits [(Item.4) (Item.44)] >> endobj 1526 0 obj << -/Names [(page.43) 926 0 R (page.44) 934 0 R (page.45) 943 0 R (page.46) 951 0 R (page.47) 955 0 R (page.48) 966 0 R] -/Limits [(page.43) (page.48)] +/Names [(Item.45) 970 0 R (Item.46) 971 0 R (Item.47) 1018 0 R (Item.48) 1024 0 R (Item.49) 1025 0 R (Item.5) 649 0 R] +/Limits [(Item.45) (Item.5)] >> endobj 1527 0 obj << -/Names [(page.49) 971 0 R (page.5) 629 0 R (page.50) 978 0 R (page.51) 983 0 R (page.52) 987 0 R (page.53) 992 0 R] -/Limits [(page.49) (page.53)] +/Names [(Item.50) 1026 0 R (Item.51) 1027 0 R (Item.52) 1028 0 R (Item.53) 1033 0 R (Item.54) 1039 0 R (Item.55) 1040 0 R] +/Limits [(Item.50) (Item.55)] >> endobj 1528 0 obj << -/Names [(page.54) 997 0 R (page.55) 1006 0 R (page.56) 1013 0 R (page.57) 1021 0 R (page.58) 1028 0 R (page.59) 1033 0 R] -/Limits [(page.54) (page.59)] +/Names [(Item.56) 1047 0 R (Item.57) 1070 0 R (Item.58) 1071 0 R (Item.59) 1078 0 R (Item.6) 650 0 R (Item.60) 1079 0 R] +/Limits [(Item.56) (Item.60)] >> endobj 1529 0 obj << -/Names [(page.6) 633 0 R (page.60) 1039 0 R (page.61) 1043 0 R (page.62) 1052 0 R (page.63) 1062 0 R (page.64) 1066 0 R] -/Limits [(page.6) (page.64)] +/Names [(Item.61) 1080 0 R (Item.62) 1092 0 R (Item.63) 1093 0 R (Item.64) 1094 0 R (Item.65) 1095 0 R (Item.66) 1096 0 R] +/Limits [(Item.61) (Item.66)] >> endobj 1530 0 obj << -/Names [(page.65) 1078 0 R (page.66) 1084 0 R (page.67) 1093 0 R (page.68) 1100 0 R (page.69) 1106 0 R (page.7) 646 0 R] -/Limits [(page.65) (page.7)] +/Names [(Item.67) 1097 0 R (Item.68) 1104 0 R (Item.69) 1105 0 R (Item.7) 651 0 R (Item.70) 1111 0 R (Item.71) 1112 0 R] +/Limits [(Item.67) (Item.71)] >> endobj 1531 0 obj << -/Names [(page.70) 1111 0 R (page.71) 1115 0 R (page.72) 1122 0 R (page.73) 1127 0 R (page.74) 1132 0 R (page.75) 1137 0 R] -/Limits [(page.70) (page.75)] +/Names [(Item.72) 1113 0 R (Item.73) 1126 0 R (Item.74) 1141 0 R (Item.75) 1142 0 R (Item.76) 1167 0 R (Item.77) 1168 0 R] +/Limits [(Item.72) (Item.77)] >> endobj 1532 0 obj << -/Names [(page.76) 1141 0 R (page.77) 1148 0 R (page.78) 1153 0 R (page.79) 1159 0 R (page.8) 665 0 R (page.80) 1166 0 R] -/Limits [(page.76) (page.80)] +/Names [(Item.78) 1180 0 R (Item.79) 1186 0 R (Item.8) 652 0 R (Item.80) 1192 0 R (Item.81) 1198 0 R (Item.82) 1204 0 R] +/Limits [(Item.78) (Item.82)] >> endobj 1533 0 obj << -/Names [(page.81) 1172 0 R (page.82) 1178 0 R (page.83) 1185 0 R (page.84) 1192 0 R (page.85) 1196 0 R (page.86) 1207 0 R] -/Limits [(page.81) (page.86)] +/Names [(Item.83) 1205 0 R (Item.84) 1211 0 R (Item.85) 1212 0 R (Item.86) 1223 0 R (Item.87) 1224 0 R (Item.88) 1225 0 R] +/Limits [(Item.83) (Item.88)] >> endobj 1534 0 obj << -/Names [(page.87) 1211 0 R (page.88) 1215 0 R (page.89) 1228 0 R (page.9) 671 0 R (page.90) 1232 0 R (page.91) 1238 0 R] -/Limits [(page.87) (page.91)] +/Names [(Item.89) 1241 0 R (Item.9) 657 0 R (Item.90) 1242 0 R (Item.91) 1243 0 R (Item.92) 1244 0 R (Item.93) 1245 0 R] +/Limits [(Item.89) (Item.93)] >> endobj 1535 0 obj << -/Names [(page.92) 1245 0 R (page.93) 1252 0 R (page.94) 1256 0 R (page.95) 1260 0 R (page.96) 1264 0 R (page.97) 1268 0 R] -/Limits [(page.92) (page.97)] +/Names [(Item.94) 1246 0 R (Item.95) 1247 0 R (Item.96) 1248 0 R (Item.97) 1249 0 R (Item.98) 1259 0 R (Item.99) 1260 0 R] +/Limits [(Item.94) (Item.99)] >> endobj 1536 0 obj << -/Names [(page.98) 1273 0 R (page.99) 1277 0 R (page.i) 487 0 R (page.ii) 538 0 R (page.iii) 556 0 R (page.iv) 560 0 R] -/Limits [(page.98) (page.iv)] +/Names [(cite.2007c) 632 0 R (cite.2007d) 633 0 R (cite.BLACS) 603 0 R (cite.BLAS1) 589 0 R (cite.BLAS2) 590 0 R (cite.BLAS3) 591 0 R] +/Limits [(cite.2007c) (cite.BLAS3)] >> endobj 1537 0 obj << -/Names [(precdata) 719 0 R (section*.1) 488 0 R (section*.10) 94 0 R (section*.11) 98 0 R (section*.12) 106 0 R (section*.13) 110 0 R] -/Limits [(precdata) (section*.13)] +/Names [(cite.KIVA3PSBLAS) 1456 0 R (cite.METIS) 619 0 R (cite.MPI1) 1461 0 R (cite.PARA04FOREST) 1454 0 R (cite.PSBLAS) 1455 0 R (cite.machiels) 586 0 R] +/Limits [(cite.KIVA3PSBLAS) (cite.machiels)] >> endobj 1538 0 obj << -/Names [(section*.14) 114 0 R (section*.15) 118 0 R (section*.16) 122 0 R (section*.17) 126 0 R (section*.18) 130 0 R (section*.19) 134 0 R] -/Limits [(section*.14) (section*.19)] +/Names [(cite.metcalf) 585 0 R (cite.sblas02) 588 0 R (cite.sblas97) 587 0 R (descdata) 682 0 R (equation.1) 886 0 R (equation.2) 887 0 R] +/Limits [(cite.metcalf) (equation.2)] >> endobj 1539 0 obj << -/Names [(section*.2) 62 0 R (section*.20) 138 0 R (section*.21) 142 0 R (section*.22) 146 0 R (section*.23) 150 0 R (section*.24) 158 0 R] -/Limits [(section*.2) (section*.24)] +/Names [(equation.3) 888 0 R (figure.1) 598 0 R (figure.10) 1347 0 R (figure.2) 627 0 R (figure.3) 700 0 R (figure.4) 721 0 R] +/Limits [(equation.3) (figure.4)] >> endobj 1540 0 obj << -/Names [(section*.25) 162 0 R (section*.26) 166 0 R (section*.27) 170 0 R (section*.28) 178 0 R (section*.29) 182 0 R (section*.3) 66 0 R] -/Limits [(section*.25) (section*.3)] +/Names [(figure.5) 716 0 R (figure.6) 750 0 R (figure.7) 943 0 R (figure.8) 972 0 R (figure.9) 1346 0 R (page.1) 437 0 R] +/Limits [(figure.5) (page.1)] >> endobj 1541 0 obj << -/Names [(section*.30) 186 0 R (section*.31) 190 0 R (section*.32) 194 0 R (section*.33) 198 0 R (section*.34) 202 0 R (section*.35) 206 0 R] -/Limits [(section*.30) (section*.35)] +/Names [(page.10) 691 0 R (page.100) 1298 0 R (page.101) 1302 0 R (page.102) 1308 0 R (page.103) 1314 0 R (page.104) 1321 0 R] +/Limits [(page.10) (page.104)] >> endobj 1542 0 obj << -/Names [(section*.36) 210 0 R (section*.37) 214 0 R (section*.38) 218 0 R (section*.39) 222 0 R (section*.4) 70 0 R (section*.40) 226 0 R] -/Limits [(section*.36) (section*.40)] +/Names [(page.105) 1327 0 R (page.106) 1333 0 R (page.107) 1338 0 R (page.108) 1345 0 R (page.109) 1351 0 R (page.11) 705 0 R] +/Limits [(page.105) (page.11)] >> endobj 1543 0 obj << -/Names [(section*.41) 230 0 R (section*.42) 234 0 R (section*.43) 238 0 R (section*.44) 242 0 R (section*.45) 246 0 R (section*.46) 250 0 R] -/Limits [(section*.41) (section*.46)] +/Names [(page.110) 1356 0 R (page.111) 1360 0 R (page.112) 1364 0 R (page.113) 1368 0 R (page.114) 1372 0 R (page.115) 1377 0 R] +/Limits [(page.110) (page.115)] >> endobj 1544 0 obj << -/Names [(section*.47) 254 0 R (section*.48) 258 0 R (section*.49) 262 0 R (section*.5) 74 0 R (section*.50) 266 0 R (section*.51) 270 0 R] -/Limits [(section*.47) (section*.51)] +/Names [(page.116) 1383 0 R (page.117) 1388 0 R (page.118) 1392 0 R (page.119) 1397 0 R (page.12) 711 0 R (page.120) 1401 0 R] +/Limits [(page.116) (page.120)] >> endobj 1545 0 obj << -/Names [(section*.52) 274 0 R (section*.53) 278 0 R (section*.54) 282 0 R (section*.55) 290 0 R (section*.56) 294 0 R (section*.57) 298 0 R] -/Limits [(section*.52) (section*.57)] +/Names [(page.121) 1407 0 R (page.122) 1417 0 R (page.123) 1423 0 R (page.124) 1428 0 R (page.125) 1432 0 R (page.126) 1438 0 R] +/Limits [(page.121) (page.126)] >> endobj 1546 0 obj << -/Names [(section*.58) 302 0 R (section*.59) 306 0 R (section*.6) 78 0 R (section*.60) 310 0 R (section*.61) 314 0 R (section*.62) 318 0 R] -/Limits [(section*.58) (section*.62)] +/Names [(page.127) 1443 0 R (page.128) 1448 0 R (page.129) 1452 0 R (page.13) 720 0 R (page.130) 1460 0 R (page.14) 726 0 R] +/Limits [(page.127) (page.14)] >> endobj 1547 0 obj << -/Names [(section*.63) 322 0 R (section*.64) 326 0 R (section*.65) 330 0 R (section*.66) 334 0 R (section*.67) 338 0 R (section*.68) 342 0 R] -/Limits [(section*.63) (section*.68)] +/Names [(page.15) 732 0 R (page.16) 740 0 R (page.17) 748 0 R (page.18) 755 0 R (page.19) 763 0 R (page.2) 447 0 R] +/Limits [(page.15) (page.2)] >> endobj 1548 0 obj << -/Names [(section*.69) 346 0 R (section*.7) 82 0 R (section*.70) 350 0 R (section*.71) 358 0 R (section*.72) 362 0 R (section*.73) 366 0 R] -/Limits [(section*.69) (section*.73)] +/Names [(page.20) 770 0 R (page.21) 775 0 R (page.22) 780 0 R (page.23) 790 0 R (page.24) 795 0 R (page.25) 803 0 R] +/Limits [(page.20) (page.25)] >> endobj 1549 0 obj << -/Names [(section*.74) 370 0 R (section*.75) 378 0 R (section*.76) 382 0 R (section*.77) 386 0 R (section*.78) 390 0 R (section*.79) 394 0 R] -/Limits [(section*.74) (section*.79)] +/Names [(page.26) 809 0 R (page.27) 817 0 R (page.28) 822 0 R (page.29) 828 0 R (page.3) 610 0 R (page.30) 835 0 R] +/Limits [(page.26) (page.30)] >> endobj 1550 0 obj << -/Names [(section*.8) 86 0 R (section*.80) 402 0 R (section*.81) 406 0 R (section*.82) 410 0 R (section*.83) 414 0 R (section*.84) 422 0 R] -/Limits [(section*.8) (section*.84)] +/Names [(page.31) 842 0 R (page.32) 850 0 R (page.33) 855 0 R (page.34) 861 0 R (page.35) 868 0 R (page.36) 875 0 R] +/Limits [(page.31) (page.36)] >> endobj 1551 0 obj << -/Names [(section*.85) 1427 0 R (section*.9) 90 0 R (section.1) 10 0 R (section.10) 398 0 R (section.11) 418 0 R (section.2) 14 0 R] -/Limits [(section*.85) (section.2)] +/Names [(page.37) 885 0 R (page.38) 900 0 R (page.39) 906 0 R (page.4) 626 0 R (page.40) 915 0 R (page.41) 921 0 R] +/Limits [(page.37) (page.41)] >> endobj 1552 0 obj << -/Names [(section.3) 34 0 R (section.4) 102 0 R (section.5) 154 0 R (section.6) 174 0 R (section.7) 286 0 R (section.8) 354 0 R] -/Limits [(section.3) (section.8)] +/Names [(page.42) 926 0 R (page.43) 933 0 R (page.44) 942 0 R (page.45) 952 0 R (page.46) 959 0 R (page.47) 968 0 R] +/Limits [(page.42) (page.47)] >> endobj 1553 0 obj << -/Names [(section.9) 374 0 R (spdata) 696 0 R (subsection.2.1) 18 0 R (subsection.2.2) 22 0 R (subsection.2.3) 26 0 R (subsection.2.4) 30 0 R] -/Limits [(section.9) (subsection.2.4)] +/Names [(page.48) 976 0 R (page.49) 980 0 R (page.5) 639 0 R (page.50) 992 0 R (page.51) 997 0 R (page.52) 1003 0 R] +/Limits [(page.48) (page.52)] >> endobj 1554 0 obj << -/Names [(subsection.3.1) 38 0 R (subsection.3.2) 46 0 R (subsection.3.3) 54 0 R (subsection.3.4) 58 0 R (subsubsection.3.1.1) 42 0 R (subsubsection.3.2.1) 50 0 R] -/Limits [(subsection.3.1) (subsubsection.3.2.1)] +/Names [(page.53) 1008 0 R (page.54) 1012 0 R (page.55) 1017 0 R (page.56) 1023 0 R (page.57) 1032 0 R (page.58) 1038 0 R] +/Limits [(page.53) (page.58)] >> endobj 1555 0 obj << -/Names [(table.1) 766 0 R (table.10) 852 0 R (table.11) 864 0 R (table.12) 881 0 R (table.13) 909 0 R (table.14) 935 0 R] -/Limits [(table.1) (table.14)] +/Names [(page.59) 1046 0 R (page.6) 643 0 R (page.60) 1053 0 R (page.61) 1058 0 R (page.62) 1065 0 R (page.63) 1069 0 R] +/Limits [(page.59) (page.63)] >> endobj 1556 0 obj << -/Names [(table.15) 967 0 R (table.16) 979 0 R (table.2) 779 0 R (table.3) 792 0 R (table.4) 804 0 R (table.5) 811 0 R] -/Limits [(table.15) (table.5)] +/Names [(page.64) 1077 0 R (page.65) 1087 0 R (page.66) 1091 0 R (page.67) 1103 0 R (page.68) 1110 0 R (page.69) 1119 0 R] +/Limits [(page.64) (page.69)] >> endobj 1557 0 obj << -/Names [(table.6) 818 0 R (table.7) 825 0 R (table.8) 837 0 R (table.9) 844 0 R (title.0) 6 0 R] -/Limits [(table.6) (title.0)] +/Names [(page.7) 656 0 R (page.70) 1125 0 R (page.71) 1131 0 R (page.72) 1136 0 R (page.73) 1140 0 R (page.74) 1148 0 R] +/Limits [(page.7) (page.74)] >> endobj 1558 0 obj << -/Kids [1491 0 R 1492 0 R 1493 0 R 1494 0 R 1495 0 R 1496 0 R] -/Limits [(Doc-Start) (Item.26)] +/Names [(page.75) 1153 0 R (page.76) 1157 0 R (page.77) 1162 0 R (page.78) 1166 0 R (page.79) 1173 0 R (page.8) 675 0 R] +/Limits [(page.75) (page.8)] >> endobj 1559 0 obj << -/Kids [1497 0 R 1498 0 R 1499 0 R 1500 0 R 1501 0 R 1502 0 R] -/Limits [(Item.27) (Item.59)] +/Names [(page.80) 1179 0 R (page.81) 1185 0 R (page.82) 1191 0 R (page.83) 1197 0 R (page.84) 1203 0 R (page.85) 1210 0 R] +/Limits [(page.80) (page.85)] >> endobj 1560 0 obj << -/Kids [1503 0 R 1504 0 R 1505 0 R 1506 0 R 1507 0 R 1508 0 R] -/Limits [(Item.6) (Item.91)] +/Names [(page.86) 1218 0 R (page.87) 1222 0 R (page.88) 1232 0 R (page.89) 1236 0 R (page.9) 681 0 R (page.90) 1240 0 R] +/Limits [(page.86) (page.90)] >> endobj 1561 0 obj << -/Kids [1509 0 R 1510 0 R 1511 0 R 1512 0 R 1513 0 R 1514 0 R] -/Limits [(Item.92) (figure.9)] +/Names [(page.91) 1253 0 R (page.92) 1258 0 R (page.93) 1264 0 R (page.94) 1270 0 R (page.95) 1277 0 R (page.96) 1281 0 R] +/Limits [(page.91) (page.96)] >> endobj 1562 0 obj << -/Kids [1515 0 R 1516 0 R 1517 0 R 1518 0 R 1519 0 R 1520 0 R] -/Limits [(page.1) (page.15)] +/Names [(page.97) 1285 0 R (page.98) 1290 0 R (page.99) 1294 0 R (page.i) 495 0 R (page.ii) 548 0 R (page.iii) 566 0 R] +/Limits [(page.97) (page.iii)] >> endobj 1563 0 obj << -/Kids [1521 0 R 1522 0 R 1523 0 R 1524 0 R 1525 0 R 1526 0 R] -/Limits [(page.16) (page.48)] +/Names [(page.iv) 570 0 R (precdata) 749 0 R (section*.1) 496 0 R (section*.10) 102 0 R (section*.11) 106 0 R (section*.12) 114 0 R] +/Limits [(page.iv) (section*.12)] >> endobj 1564 0 obj << -/Kids [1527 0 R 1528 0 R 1529 0 R 1530 0 R 1531 0 R 1532 0 R] -/Limits [(page.49) (page.80)] +/Names [(section*.13) 118 0 R (section*.14) 122 0 R (section*.15) 126 0 R (section*.16) 130 0 R (section*.17) 134 0 R (section*.18) 138 0 R] +/Limits [(section*.13) (section*.18)] >> endobj 1565 0 obj << -/Kids [1533 0 R 1534 0 R 1535 0 R 1536 0 R 1537 0 R 1538 0 R] -/Limits [(page.81) (section*.19)] +/Names [(section*.19) 142 0 R (section*.2) 70 0 R (section*.20) 146 0 R (section*.21) 150 0 R (section*.22) 154 0 R (section*.23) 158 0 R] +/Limits [(section*.19) (section*.23)] >> endobj 1566 0 obj << -/Kids [1539 0 R 1540 0 R 1541 0 R 1542 0 R 1543 0 R 1544 0 R] -/Limits [(section*.2) (section*.51)] +/Names [(section*.24) 166 0 R (section*.25) 170 0 R (section*.26) 174 0 R (section*.27) 178 0 R (section*.28) 186 0 R (section*.29) 190 0 R] +/Limits [(section*.24) (section*.29)] >> endobj 1567 0 obj << -/Kids [1545 0 R 1546 0 R 1547 0 R 1548 0 R 1549 0 R 1550 0 R] -/Limits [(section*.52) (section*.84)] +/Names [(section*.3) 74 0 R (section*.30) 194 0 R (section*.31) 198 0 R (section*.32) 202 0 R (section*.33) 206 0 R (section*.34) 210 0 R] +/Limits [(section*.3) (section*.34)] >> endobj 1568 0 obj << -/Kids [1551 0 R 1552 0 R 1553 0 R 1554 0 R 1555 0 R 1556 0 R] -/Limits [(section*.85) (table.5)] +/Names [(section*.35) 214 0 R (section*.36) 218 0 R (section*.37) 222 0 R (section*.38) 226 0 R (section*.39) 230 0 R (section*.4) 78 0 R] +/Limits [(section*.35) (section*.4)] >> endobj 1569 0 obj << -/Kids [1557 0 R] -/Limits [(table.6) (title.0)] +/Names [(section*.40) 234 0 R (section*.41) 238 0 R (section*.42) 242 0 R (section*.43) 246 0 R (section*.44) 250 0 R (section*.45) 254 0 R] +/Limits [(section*.40) (section*.45)] >> endobj 1570 0 obj << -/Kids [1558 0 R 1559 0 R 1560 0 R 1561 0 R 1562 0 R 1563 0 R] -/Limits [(Doc-Start) (page.48)] +/Names [(section*.46) 258 0 R (section*.47) 262 0 R (section*.48) 266 0 R (section*.49) 270 0 R (section*.5) 82 0 R (section*.50) 274 0 R] +/Limits [(section*.46) (section*.50)] >> endobj 1571 0 obj << -/Kids [1564 0 R 1565 0 R 1566 0 R 1567 0 R 1568 0 R 1569 0 R] -/Limits [(page.49) (title.0)] +/Names [(section*.51) 278 0 R (section*.52) 282 0 R (section*.53) 286 0 R (section*.54) 290 0 R (section*.55) 298 0 R (section*.56) 302 0 R] +/Limits [(section*.51) (section*.56)] >> endobj 1572 0 obj << -/Kids [1570 0 R 1571 0 R] -/Limits [(Doc-Start) (title.0)] +/Names [(section*.57) 306 0 R (section*.58) 310 0 R (section*.59) 314 0 R (section*.6) 86 0 R (section*.60) 318 0 R (section*.61) 322 0 R] +/Limits [(section*.57) (section*.61)] >> endobj 1573 0 obj << -/Dests 1572 0 R +/Names [(section*.62) 326 0 R (section*.63) 330 0 R (section*.64) 334 0 R (section*.65) 338 0 R (section*.66) 342 0 R (section*.67) 346 0 R] +/Limits [(section*.62) (section*.67)] >> endobj 1574 0 obj << -/Type /Catalog -/Pages 1489 0 R -/Outlines 1490 0 R -/Names 1573 0 R - /URI (http://ce.uniroma2.it/psblas) /PageMode/UseOutlines/PageLabels << /Nums [0 << /S /D >> 2 << /S /r >> 6 << /S /D >> ] >> -/OpenAction 425 0 R +/Names [(section*.68) 350 0 R (section*.69) 354 0 R (section*.7) 90 0 R (section*.70) 358 0 R (section*.71) 366 0 R (section*.72) 370 0 R] +/Limits [(section*.68) (section*.72)] >> endobj 1575 0 obj << +/Names [(section*.73) 374 0 R (section*.74) 378 0 R (section*.75) 386 0 R (section*.76) 390 0 R (section*.77) 394 0 R (section*.78) 398 0 R] +/Limits [(section*.73) (section*.78)] +>> endobj +1576 0 obj << +/Names [(section*.79) 402 0 R (section*.8) 94 0 R (section*.80) 410 0 R (section*.81) 414 0 R (section*.82) 418 0 R (section*.83) 422 0 R] +/Limits [(section*.79) (section*.83)] +>> endobj +1577 0 obj << +/Names [(section*.84) 430 0 R (section*.85) 1453 0 R (section*.9) 98 0 R (section.1) 10 0 R (section.10) 406 0 R (section.11) 426 0 R] +/Limits [(section*.84) (section.11)] +>> endobj +1578 0 obj << +/Names [(section.2) 14 0 R (section.3) 34 0 R (section.4) 110 0 R (section.5) 162 0 R (section.6) 182 0 R (section.7) 294 0 R] +/Limits [(section.2) (section.7)] +>> endobj +1579 0 obj << +/Names [(section.8) 362 0 R (section.9) 382 0 R (spdata) 706 0 R (subsection.2.1) 18 0 R (subsection.2.2) 22 0 R (subsection.2.3) 26 0 R] +/Limits [(section.8) (subsection.2.3)] +>> endobj +1580 0 obj << +/Names [(subsection.2.4) 30 0 R (subsection.3.1) 38 0 R (subsection.3.2) 46 0 R (subsection.3.3) 54 0 R (subsection.3.4) 62 0 R (subsection.3.5) 66 0 R] +/Limits [(subsection.2.4) (subsection.3.5)] +>> endobj +1581 0 obj << +/Names [(subsubsection.3.1.1) 42 0 R (subsubsection.3.2.1) 50 0 R (subsubsection.3.3.1) 58 0 R (table.1) 791 0 R (table.10) 877 0 R (table.11) 889 0 R] +/Limits [(subsubsection.3.1.1) (table.11)] +>> endobj +1582 0 obj << +/Names [(table.12) 907 0 R (table.13) 934 0 R (table.14) 960 0 R (table.15) 993 0 R (table.16) 1004 0 R (table.2) 804 0 R] +/Limits [(table.12) (table.2)] +>> endobj +1583 0 obj << +/Names [(table.3) 818 0 R (table.4) 829 0 R (table.5) 836 0 R (table.6) 843 0 R (table.7) 851 0 R (table.8) 862 0 R] +/Limits [(table.3) (table.8)] +>> endobj +1584 0 obj << +/Names [(table.9) 869 0 R (title.0) 6 0 R (vdata) 727 0 R] +/Limits [(table.9) (vdata)] +>> endobj +1585 0 obj << +/Kids [1516 0 R 1517 0 R 1518 0 R 1519 0 R 1520 0 R 1521 0 R] +/Limits [(Doc-Start) (Item.22)] +>> endobj +1586 0 obj << +/Kids [1522 0 R 1523 0 R 1524 0 R 1525 0 R 1526 0 R 1527 0 R] +/Limits [(Item.23) (Item.55)] +>> endobj +1587 0 obj << +/Kids [1528 0 R 1529 0 R 1530 0 R 1531 0 R 1532 0 R 1533 0 R] +/Limits [(Item.56) (Item.88)] +>> endobj +1588 0 obj << +/Kids [1534 0 R 1535 0 R 1536 0 R 1537 0 R 1538 0 R 1539 0 R] +/Limits [(Item.89) (figure.4)] +>> endobj +1589 0 obj << +/Kids [1540 0 R 1541 0 R 1542 0 R 1543 0 R 1544 0 R 1545 0 R] +/Limits [(figure.5) (page.126)] +>> endobj +1590 0 obj << +/Kids [1546 0 R 1547 0 R 1548 0 R 1549 0 R 1550 0 R 1551 0 R] +/Limits [(page.127) (page.41)] +>> endobj +1591 0 obj << +/Kids [1552 0 R 1553 0 R 1554 0 R 1555 0 R 1556 0 R 1557 0 R] +/Limits [(page.42) (page.74)] +>> endobj +1592 0 obj << +/Kids [1558 0 R 1559 0 R 1560 0 R 1561 0 R 1562 0 R 1563 0 R] +/Limits [(page.75) (section*.12)] +>> endobj +1593 0 obj << +/Kids [1564 0 R 1565 0 R 1566 0 R 1567 0 R 1568 0 R 1569 0 R] +/Limits [(section*.13) (section*.45)] +>> endobj +1594 0 obj << +/Kids [1570 0 R 1571 0 R 1572 0 R 1573 0 R 1574 0 R 1575 0 R] +/Limits [(section*.46) (section*.78)] +>> endobj +1595 0 obj << +/Kids [1576 0 R 1577 0 R 1578 0 R 1579 0 R 1580 0 R 1581 0 R] +/Limits [(section*.79) (table.11)] +>> endobj +1596 0 obj << +/Kids [1582 0 R 1583 0 R 1584 0 R] +/Limits [(table.12) (vdata)] +>> endobj +1597 0 obj << +/Kids [1585 0 R 1586 0 R 1587 0 R 1588 0 R 1589 0 R 1590 0 R] +/Limits [(Doc-Start) (page.41)] +>> endobj +1598 0 obj << +/Kids [1591 0 R 1592 0 R 1593 0 R 1594 0 R 1595 0 R 1596 0 R] +/Limits [(page.42) (vdata)] +>> endobj +1599 0 obj << +/Kids [1597 0 R 1598 0 R] +/Limits [(Doc-Start) (vdata)] +>> endobj +1600 0 obj << +/Dests 1599 0 R +>> endobj +1601 0 obj << +/Type /Catalog +/Pages 1514 0 R +/Outlines 1515 0 R +/Names 1600 0 R + /URI (http://ce.uniroma2.it/psblas) /PageMode/UseOutlines/PageLabels << /Nums [0 << /S /D >> 2 << /S /r >> 6 << /S /D >> ] >> +/OpenAction 433 0 R +>> endobj +1602 0 obj << /Title (Parallel Sparse BLAS V. 3.0-beta) /Subject (Parallel Sparse Basic Linear Algebra Subroutines) /Keywords (Computer Science Linear Algebra Fluid Dynamics Parallel Linux MPI PSBLAS Iterative Solvers Preconditioners) /Creator (pdfLaTeX) /Producer ($Id: userguide.tex 4222 2010-05-13 12:08:31Z sfilippo $) /Author()/Title()/Subject()/Creator(LaTeX with hyperref package)/Producer(pdfTeX-1.40.3)/Keywords() -/CreationDate (D:20110325174559+01'00') -/ModDate (D:20110325174559+01'00') +/CreationDate (D:20111013143803+02'00') +/ModDate (D:20111013143803+02'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX using libpoppler, Version 3.141592-1.40.3-2.2 (Web2C 7.5.6) kpathsea version 3.5.6) >> endobj xref -0 1576 +0 1603 0000000001 65535 f 0000000002 00000 f 0000000003 00000 f 0000000004 00000 f 0000000000 00000 f 0000000015 00000 n -0000010143 00000 n -0000900289 00000 n +0000010239 00000 n +0000918547 00000 n 0000000058 00000 n 0000000105 00000 n -0000084075 00000 n -0000900217 00000 n +0000083471 00000 n +0000918475 00000 n 0000000150 00000 n 0000000183 00000 n -0000092008 00000 n -0000900094 00000 n +0000091404 00000 n +0000918352 00000 n 0000000229 00000 n 0000000266 00000 n -0000102238 00000 n -0000900020 00000 n +0000101634 00000 n +0000918278 00000 n 0000000317 00000 n 0000000358 00000 n -0000110485 00000 n -0000899933 00000 n +0000109881 00000 n +0000918191 00000 n 0000000409 00000 n 0000000448 00000 n -0000125959 00000 n -0000899846 00000 n +0000125355 00000 n +0000918104 00000 n 0000000499 00000 n 0000000543 00000 n -0000138580 00000 n -0000899772 00000 n +0000137976 00000 n +0000918030 00000 n 0000000594 00000 n 0000000634 00000 n -0000147106 00000 n -0000899648 00000 n +0000146502 00000 n +0000917906 00000 n 0000000680 00000 n 0000000716 00000 n -0000147166 00000 n -0000899537 00000 n +0000146562 00000 n +0000917795 00000 n 0000000767 00000 n 0000000815 00000 n -0000163568 00000 n -0000899476 00000 n +0000162964 00000 n +0000917734 00000 n 0000000871 00000 n 0000000911 00000 n -0000163628 00000 n -0000899352 00000 n +0000163024 00000 n +0000917610 00000 n 0000000962 00000 n 0000001013 00000 n -0000187318 00000 n -0000899291 00000 n +0000184747 00000 n +0000917549 00000 n 0000001069 00000 n 0000001109 00000 n -0000187379 00000 n -0000899204 00000 n +0000184808 00000 n +0000917425 00000 n 0000001160 00000 n -0000001212 00000 n -0000187501 00000 n -0000899092 00000 n -0000001263 00000 n -0000001315 00000 n -0000187562 00000 n -0000899018 00000 n -0000001362 00000 n -0000001415 00000 n -0000192243 00000 n -0000898931 00000 n -0000001462 00000 n -0000001515 00000 n -0000199506 00000 n -0000898844 00000 n -0000001562 00000 n -0000001616 00000 n -0000199567 00000 n -0000898757 00000 n -0000001663 00000 n -0000001717 00000 n -0000205177 00000 n -0000898670 00000 n -0000001764 00000 n -0000001810 00000 n -0000205237 00000 n -0000898583 00000 n -0000001857 00000 n -0000001914 00000 n -0000205297 00000 n -0000898496 00000 n -0000001961 00000 n -0000002018 00000 n -0000212198 00000 n -0000898409 00000 n -0000002065 00000 n -0000002110 00000 n -0000212259 00000 n -0000898322 00000 n -0000002158 00000 n -0000002202 00000 n -0000212320 00000 n -0000898247 00000 n -0000002250 00000 n -0000002297 00000 n -0000213891 00000 n -0000898117 00000 n -0000002344 00000 n -0000002388 00000 n -0000222045 00000 n -0000898038 00000 n -0000002437 00000 n -0000002471 00000 n -0000232097 00000 n -0000897945 00000 n -0000002520 00000 n -0000002552 00000 n -0000241672 00000 n -0000897852 00000 n -0000002601 00000 n -0000002634 00000 n -0000249987 00000 n -0000897759 00000 n -0000002683 00000 n -0000002716 00000 n -0000256636 00000 n -0000897666 00000 n -0000002765 00000 n -0000002799 00000 n -0000263649 00000 n -0000897573 00000 n -0000002848 00000 n -0000002881 00000 n -0000271360 00000 n -0000897480 00000 n -0000002930 00000 n -0000002964 00000 n -0000279418 00000 n -0000897387 00000 n -0000003013 00000 n -0000003047 00000 n -0000285903 00000 n -0000897294 00000 n -0000003096 00000 n -0000003130 00000 n -0000292216 00000 n -0000897201 00000 n -0000003179 00000 n -0000003212 00000 n -0000300739 00000 n -0000897108 00000 n -0000003261 00000 n -0000003292 00000 n -0000317973 00000 n -0000897029 00000 n -0000003341 00000 n -0000003372 00000 n -0000332629 00000 n -0000896899 00000 n -0000003419 00000 n -0000003463 00000 n -0000339525 00000 n -0000896820 00000 n -0000003512 00000 n -0000003543 00000 n -0000359847 00000 n -0000896727 00000 n -0000003592 00000 n -0000003623 00000 n -0000384189 00000 n -0000896634 00000 n -0000003672 00000 n -0000003705 00000 n -0000393772 00000 n -0000896555 00000 n -0000003754 00000 n -0000003788 00000 n -0000403051 00000 n -0000896424 00000 n -0000003835 00000 n -0000003881 00000 n -0000403113 00000 n -0000896345 00000 n -0000003930 00000 n -0000003962 00000 n -0000427843 00000 n -0000896252 00000 n -0000004011 00000 n -0000004043 00000 n -0000432228 00000 n -0000896159 00000 n -0000004092 00000 n -0000004124 00000 n -0000436319 00000 n -0000896066 00000 n -0000004173 00000 n -0000004205 00000 n -0000439153 00000 n -0000895973 00000 n -0000004254 00000 n -0000004287 00000 n -0000445816 00000 n -0000895880 00000 n -0000004336 00000 n -0000004371 00000 n -0000453524 00000 n -0000895787 00000 n -0000004420 00000 n -0000004452 00000 n -0000461311 00000 n -0000895694 00000 n -0000004501 00000 n -0000004533 00000 n -0000471815 00000 n -0000895601 00000 n -0000004582 00000 n -0000004614 00000 n -0000477820 00000 n -0000895508 00000 n -0000004663 00000 n -0000004696 00000 n -0000482544 00000 n -0000895415 00000 n -0000004745 00000 n -0000004776 00000 n -0000487802 00000 n -0000895322 00000 n -0000004825 00000 n -0000004857 00000 n -0000494582 00000 n -0000895229 00000 n -0000004906 00000 n -0000004938 00000 n -0000499075 00000 n -0000895136 00000 n -0000004987 00000 n -0000005019 00000 n -0000502547 00000 n -0000895043 00000 n -0000005068 00000 n -0000005101 00000 n -0000506404 00000 n -0000894950 00000 n -0000005150 00000 n -0000005181 00000 n -0000513561 00000 n -0000894857 00000 n -0000005230 00000 n -0000005274 00000 n -0000521051 00000 n -0000894764 00000 n -0000005323 00000 n -0000005367 00000 n -0000524927 00000 n -0000894671 00000 n -0000005416 00000 n -0000005454 00000 n -0000530568 00000 n -0000894578 00000 n -0000005503 00000 n -0000005544 00000 n -0000534475 00000 n -0000894485 00000 n -0000005593 00000 n -0000005631 00000 n -0000540100 00000 n -0000894392 00000 n -0000005680 00000 n -0000005721 00000 n -0000544570 00000 n -0000894299 00000 n -0000005770 00000 n -0000005812 00000 n -0000548943 00000 n -0000894206 00000 n -0000005861 00000 n -0000005902 00000 n -0000555448 00000 n -0000894113 00000 n -0000005951 00000 n -0000005990 00000 n -0000564756 00000 n -0000894020 00000 n -0000006039 00000 n -0000006072 00000 n -0000570942 00000 n -0000893941 00000 n -0000006121 00000 n -0000006158 00000 n -0000579520 00000 n -0000893810 00000 n -0000006205 00000 n -0000006256 00000 n -0000585487 00000 n -0000893731 00000 n -0000006305 00000 n -0000006336 00000 n -0000590706 00000 n -0000893638 00000 n -0000006385 00000 n -0000006416 00000 n -0000595631 00000 n -0000893545 00000 n -0000006465 00000 n -0000006496 00000 n -0000598428 00000 n -0000893452 00000 n -0000006545 00000 n -0000006586 00000 n -0000601871 00000 n -0000893359 00000 n -0000006635 00000 n -0000006673 00000 n -0000603496 00000 n -0000893266 00000 n -0000006722 00000 n -0000006754 00000 n -0000605388 00000 n -0000893173 00000 n -0000006803 00000 n -0000006837 00000 n -0000607166 00000 n -0000893080 00000 n -0000006886 00000 n -0000006918 00000 n -0000612117 00000 n -0000892987 00000 n -0000006967 00000 n -0000006999 00000 n -0000617708 00000 n -0000892894 00000 n -0000007048 00000 n -0000007078 00000 n -0000623464 00000 n -0000892801 00000 n -0000007127 00000 n -0000007157 00000 n -0000629197 00000 n -0000892708 00000 n -0000007206 00000 n -0000007236 00000 n -0000635045 00000 n -0000892615 00000 n -0000007285 00000 n -0000007315 00000 n -0000640866 00000 n -0000892522 00000 n -0000007364 00000 n -0000007394 00000 n -0000646806 00000 n -0000892429 00000 n -0000007443 00000 n -0000007473 00000 n -0000652666 00000 n -0000892350 00000 n -0000007522 00000 n -0000007552 00000 n -0000659910 00000 n -0000892220 00000 n -0000007599 00000 n -0000007635 00000 n -0000667607 00000 n -0000892141 00000 n -0000007684 00000 n -0000007718 00000 n -0000669177 00000 n -0000892048 00000 n -0000007767 00000 n -0000007799 00000 n -0000670846 00000 n -0000891955 00000 n -0000007848 00000 n -0000007894 00000 n -0000672976 00000 n -0000891876 00000 n -0000007943 00000 n -0000007986 00000 n -0000673922 00000 n -0000891746 00000 n -0000008033 00000 n -0000008064 00000 n -0000678942 00000 n -0000891642 00000 n -0000008113 00000 n -0000008143 00000 n -0000684400 00000 n -0000891563 00000 n -0000008192 00000 n -0000008223 00000 n -0000688225 00000 n -0000891470 00000 n -0000008272 00000 n -0000008309 00000 n -0000691908 00000 n -0000891377 00000 n -0000008358 00000 n -0000008396 00000 n -0000696209 00000 n -0000891298 00000 n -0000008445 00000 n -0000008483 00000 n -0000697541 00000 n -0000891168 00000 n -0000008531 00000 n -0000008577 00000 n -0000702940 00000 n -0000891089 00000 n -0000008626 00000 n -0000008661 00000 n -0000708846 00000 n -0000890996 00000 n -0000008710 00000 n -0000008744 00000 n -0000714599 00000 n -0000890903 00000 n -0000008793 00000 n -0000008828 00000 n -0000717187 00000 n -0000890824 00000 n -0000008877 00000 n -0000008913 00000 n -0000718205 00000 n -0000890708 00000 n -0000008961 00000 n -0000009001 00000 n -0000726153 00000 n -0000890643 00000 n -0000009050 00000 n -0000009076 00000 n -0000009902 00000 n -0000010202 00000 n -0000009128 00000 n -0000010021 00000 n -0000010082 00000 n -0000885050 00000 n -0000886786 00000 n -0000884904 00000 n -0000885633 00000 n -0000887223 00000 n -0000010629 00000 n -0000010448 00000 n -0000010312 00000 n -0000010567 00000 n -0000028858 00000 n -0000029009 00000 n -0000029160 00000 n -0000029317 00000 n -0000029474 00000 n -0000029631 00000 n -0000029788 00000 n -0000029938 00000 n -0000030095 00000 n -0000030257 00000 n -0000030414 00000 n -0000030576 00000 n -0000030733 00000 n -0000030890 00000 n -0000031043 00000 n -0000031196 00000 n -0000031349 00000 n -0000031502 00000 n -0000031654 00000 n -0000031807 00000 n -0000031960 00000 n -0000032113 00000 n -0000032267 00000 n -0000032421 00000 n -0000032572 00000 n -0000032726 00000 n -0000032880 00000 n -0000033034 00000 n -0000033188 00000 n -0000033342 00000 n -0000033495 00000 n -0000033649 00000 n -0000033803 00000 n -0000033957 00000 n -0000034111 00000 n -0000034264 00000 n -0000034418 00000 n -0000034569 00000 n -0000034723 00000 n -0000034876 00000 n -0000035030 00000 n -0000056874 00000 n -0000057025 00000 n -0000057178 00000 n -0000035305 00000 n +0000001210 00000 n +0000198823 00000 n +0000917364 00000 n +0000001266 00000 n +0000001306 00000 n +0000207749 00000 n +0000917277 00000 n +0000001357 00000 n +0000001409 00000 n +0000207871 00000 n +0000917164 00000 n +0000001460 00000 n +0000001512 00000 n +0000207930 00000 n +0000917090 00000 n +0000001559 00000 n +0000001599 00000 n +0000207990 00000 n +0000917003 00000 n +0000001646 00000 n +0000001686 00000 n +0000220190 00000 n +0000916916 00000 n +0000001733 00000 n +0000001774 00000 n +0000220250 00000 n +0000916829 00000 n +0000001821 00000 n +0000001862 00000 n +0000220310 00000 n +0000916742 00000 n +0000001909 00000 n +0000001942 00000 n +0000225983 00000 n +0000916655 00000 n +0000001989 00000 n +0000002046 00000 n +0000226044 00000 n +0000916568 00000 n +0000002093 00000 n +0000002150 00000 n +0000226105 00000 n +0000916479 00000 n +0000002197 00000 n +0000002229 00000 n +0000230967 00000 n +0000916388 00000 n +0000002278 00000 n +0000002310 00000 n +0000231028 00000 n +0000916310 00000 n +0000002359 00000 n +0000002393 00000 n +0000231644 00000 n +0000916180 00000 n +0000002440 00000 n +0000002484 00000 n +0000239798 00000 n +0000916101 00000 n +0000002533 00000 n +0000002567 00000 n +0000249850 00000 n +0000916008 00000 n +0000002616 00000 n +0000002648 00000 n +0000259425 00000 n +0000915915 00000 n +0000002697 00000 n +0000002730 00000 n +0000267740 00000 n +0000915822 00000 n +0000002779 00000 n +0000002812 00000 n +0000274389 00000 n +0000915729 00000 n +0000002861 00000 n +0000002895 00000 n +0000281402 00000 n +0000915636 00000 n +0000002944 00000 n +0000002977 00000 n +0000289113 00000 n +0000915543 00000 n +0000003026 00000 n +0000003060 00000 n +0000297171 00000 n +0000915450 00000 n +0000003109 00000 n +0000003143 00000 n +0000303656 00000 n +0000915357 00000 n +0000003192 00000 n +0000003226 00000 n +0000309969 00000 n +0000915264 00000 n +0000003275 00000 n +0000003308 00000 n +0000318492 00000 n +0000915171 00000 n +0000003357 00000 n +0000003388 00000 n +0000335726 00000 n +0000915092 00000 n +0000003437 00000 n +0000003468 00000 n +0000350382 00000 n +0000914962 00000 n +0000003515 00000 n +0000003559 00000 n +0000357278 00000 n +0000914883 00000 n +0000003608 00000 n +0000003639 00000 n +0000377600 00000 n +0000914790 00000 n +0000003688 00000 n +0000003719 00000 n +0000401942 00000 n +0000914697 00000 n +0000003768 00000 n +0000003801 00000 n +0000411531 00000 n +0000914618 00000 n +0000003850 00000 n +0000003884 00000 n +0000420827 00000 n +0000914487 00000 n +0000003931 00000 n +0000003977 00000 n +0000420890 00000 n +0000914408 00000 n +0000004026 00000 n +0000004058 00000 n +0000445649 00000 n +0000914315 00000 n +0000004107 00000 n +0000004139 00000 n +0000450034 00000 n +0000914222 00000 n +0000004188 00000 n +0000004220 00000 n +0000454125 00000 n +0000914129 00000 n +0000004269 00000 n +0000004301 00000 n +0000456959 00000 n +0000914036 00000 n +0000004350 00000 n +0000004383 00000 n +0000463622 00000 n +0000913943 00000 n +0000004432 00000 n +0000004467 00000 n +0000471330 00000 n +0000913850 00000 n +0000004516 00000 n +0000004548 00000 n +0000479117 00000 n +0000913757 00000 n +0000004597 00000 n +0000004629 00000 n +0000489621 00000 n +0000913664 00000 n +0000004678 00000 n +0000004710 00000 n +0000495626 00000 n +0000913571 00000 n +0000004759 00000 n +0000004792 00000 n +0000500350 00000 n +0000913478 00000 n +0000004841 00000 n +0000004872 00000 n +0000505608 00000 n +0000913385 00000 n +0000004921 00000 n +0000004953 00000 n +0000512388 00000 n +0000913292 00000 n +0000005002 00000 n +0000005034 00000 n +0000516881 00000 n +0000913199 00000 n +0000005083 00000 n +0000005115 00000 n +0000520353 00000 n +0000913106 00000 n +0000005164 00000 n +0000005197 00000 n +0000524210 00000 n +0000913013 00000 n +0000005246 00000 n +0000005277 00000 n +0000531367 00000 n +0000912920 00000 n +0000005326 00000 n +0000005370 00000 n +0000538857 00000 n +0000912827 00000 n +0000005419 00000 n +0000005463 00000 n +0000542733 00000 n +0000912734 00000 n +0000005512 00000 n +0000005550 00000 n +0000548374 00000 n +0000912641 00000 n +0000005599 00000 n +0000005640 00000 n +0000552281 00000 n +0000912548 00000 n +0000005689 00000 n +0000005727 00000 n +0000557906 00000 n +0000912455 00000 n +0000005776 00000 n +0000005817 00000 n +0000562376 00000 n +0000912362 00000 n +0000005866 00000 n +0000005908 00000 n +0000566749 00000 n +0000912269 00000 n +0000005957 00000 n +0000005998 00000 n +0000573254 00000 n +0000912176 00000 n +0000006047 00000 n +0000006086 00000 n +0000582562 00000 n +0000912083 00000 n +0000006135 00000 n +0000006168 00000 n +0000588748 00000 n +0000912004 00000 n +0000006217 00000 n +0000006254 00000 n +0000597326 00000 n +0000911873 00000 n +0000006301 00000 n +0000006352 00000 n +0000603293 00000 n +0000911794 00000 n +0000006401 00000 n +0000006432 00000 n +0000608512 00000 n +0000911701 00000 n +0000006481 00000 n +0000006512 00000 n +0000613437 00000 n +0000911608 00000 n +0000006561 00000 n +0000006592 00000 n +0000616234 00000 n +0000911515 00000 n +0000006641 00000 n +0000006682 00000 n +0000619677 00000 n +0000911422 00000 n +0000006731 00000 n +0000006769 00000 n +0000621302 00000 n +0000911329 00000 n +0000006818 00000 n +0000006850 00000 n +0000623194 00000 n +0000911236 00000 n +0000006899 00000 n +0000006933 00000 n +0000624972 00000 n +0000911143 00000 n +0000006982 00000 n +0000007014 00000 n +0000629924 00000 n +0000911050 00000 n +0000007063 00000 n +0000007095 00000 n +0000635515 00000 n +0000910957 00000 n +0000007144 00000 n +0000007174 00000 n +0000641271 00000 n +0000910864 00000 n +0000007223 00000 n +0000007253 00000 n +0000647004 00000 n +0000910771 00000 n +0000007302 00000 n +0000007332 00000 n +0000652852 00000 n +0000910678 00000 n +0000007381 00000 n +0000007411 00000 n +0000658673 00000 n +0000910585 00000 n +0000007460 00000 n +0000007490 00000 n +0000664613 00000 n +0000910492 00000 n +0000007539 00000 n +0000007569 00000 n +0000670473 00000 n +0000910413 00000 n +0000007618 00000 n +0000007648 00000 n +0000677719 00000 n +0000910283 00000 n +0000007695 00000 n +0000007731 00000 n +0000685410 00000 n +0000910204 00000 n +0000007780 00000 n +0000007814 00000 n +0000686980 00000 n +0000910111 00000 n +0000007863 00000 n +0000007895 00000 n +0000688649 00000 n +0000910018 00000 n +0000007944 00000 n +0000007990 00000 n +0000690779 00000 n +0000909939 00000 n +0000008039 00000 n +0000008082 00000 n +0000691725 00000 n +0000909809 00000 n +0000008129 00000 n +0000008160 00000 n +0000696745 00000 n +0000909705 00000 n +0000008209 00000 n +0000008239 00000 n +0000702203 00000 n +0000909626 00000 n +0000008288 00000 n +0000008319 00000 n +0000706028 00000 n +0000909533 00000 n +0000008368 00000 n +0000008405 00000 n +0000709711 00000 n +0000909440 00000 n +0000008454 00000 n +0000008492 00000 n +0000714012 00000 n +0000909361 00000 n +0000008541 00000 n +0000008579 00000 n +0000715344 00000 n +0000909231 00000 n +0000008627 00000 n +0000008673 00000 n +0000720743 00000 n +0000909152 00000 n +0000008722 00000 n +0000008757 00000 n +0000726649 00000 n +0000909059 00000 n +0000008806 00000 n +0000008840 00000 n +0000732402 00000 n +0000908966 00000 n +0000008889 00000 n +0000008924 00000 n +0000734990 00000 n +0000908887 00000 n +0000008973 00000 n +0000009009 00000 n +0000736008 00000 n +0000908771 00000 n +0000009057 00000 n +0000009097 00000 n +0000743956 00000 n +0000908706 00000 n +0000009146 00000 n +0000009172 00000 n +0000009998 00000 n +0000010298 00000 n +0000009224 00000 n +0000010117 00000 n +0000010178 00000 n +0000903092 00000 n +0000904828 00000 n +0000902946 00000 n +0000903675 00000 n +0000905265 00000 n +0000010725 00000 n +0000010544 00000 n +0000010408 00000 n +0000010663 00000 n +0000027941 00000 n +0000028092 00000 n +0000028242 00000 n 0000028399 00000 n -0000010700 00000 n -0000035183 00000 n -0000035244 00000 n -0000057332 00000 n -0000057486 00000 n -0000057640 00000 n -0000057794 00000 n -0000057948 00000 n -0000058102 00000 n -0000058256 00000 n -0000058409 00000 n -0000058562 00000 n -0000058716 00000 n -0000058870 00000 n -0000059023 00000 n -0000059176 00000 n -0000059329 00000 n -0000059483 00000 n -0000059637 00000 n -0000059791 00000 n -0000059945 00000 n -0000060099 00000 n -0000060253 00000 n -0000060407 00000 n -0000060560 00000 n -0000060712 00000 n -0000060866 00000 n -0000061020 00000 n -0000061174 00000 n -0000061326 00000 n -0000061480 00000 n -0000061634 00000 n -0000061788 00000 n -0000061942 00000 n -0000062096 00000 n -0000062250 00000 n -0000062404 00000 n -0000062558 00000 n -0000062712 00000 n -0000062866 00000 n -0000063020 00000 n -0000063174 00000 n -0000063328 00000 n -0000063482 00000 n -0000063635 00000 n -0000071386 00000 n -0000071537 00000 n -0000071690 00000 n -0000071844 00000 n -0000063850 00000 n -0000056383 00000 n -0000035402 00000 n -0000063788 00000 n -0000071997 00000 n -0000072151 00000 n -0000072302 00000 n -0000072455 00000 n -0000072609 00000 n -0000072762 00000 n -0000072916 00000 n -0000073070 00000 n -0000073220 00000 n -0000073374 00000 n -0000073528 00000 n -0000073682 00000 n -0000073836 00000 n -0000073987 00000 n -0000074201 00000 n -0000071111 00000 n -0000063934 00000 n -0000074140 00000 n -0000074604 00000 n -0000074423 00000 n -0000074285 00000 n -0000074542 00000 n -0000083001 00000 n -0000083156 00000 n -0000083312 00000 n -0000083466 00000 n -0000083621 00000 n -0000083771 00000 n -0000083923 00000 n -0000091552 00000 n -0000091703 00000 n -0000084135 00000 n -0000082814 00000 n -0000074675 00000 n -0000886640 00000 n -0000887341 00000 n -0000745249 00000 n -0000745186 00000 n -0000743050 00000 n -0000743112 00000 n -0000743362 00000 n -0000742865 00000 n -0000742927 00000 n -0000091856 00000 n -0000089892 00000 n -0000092131 00000 n -0000089737 00000 n -0000084232 00000 n -0000885196 00000 n -0000092069 00000 n -0000091290 00000 n -0000091409 00000 n -0000091456 00000 n -0000091530 00000 n -0000742988 00000 n -0000101717 00000 n -0000101870 00000 n -0000102024 00000 n -0000102422 00000 n -0000101562 00000 n -0000092256 00000 n -0000102177 00000 n -0000886932 00000 n -0000885921 00000 n -0000885488 00000 n -0000886352 00000 n -0000885778 00000 n -0000102298 00000 n -0000886064 00000 n -0000102360 00000 n -0000743300 00000 n -0000110055 00000 n -0000110208 00000 n -0000108084 00000 n -0000110546 00000 n -0000107937 00000 n -0000102622 00000 n -0000110361 00000 n -0000110423 00000 n -0000109793 00000 n -0000109912 00000 n -0000109959 00000 n -0000110033 00000 n -0000742803 00000 n -0000742742 00000 n -0000116588 00000 n -0000116739 00000 n -0000116952 00000 n -0000116441 00000 n -0000110710 00000 n -0000116891 00000 n -0000126516 00000 n -0000125778 00000 n -0000117062 00000 n -0000125897 00000 n -0000885342 00000 n -0000126020 00000 n -0000126082 00000 n -0000126144 00000 n -0000126206 00000 n -0000126268 00000 n -0000126330 00000 n -0000126392 00000 n -0000126454 00000 n -0000134575 00000 n -0000133606 00000 n -0000126651 00000 n -0000133725 00000 n -0000133786 00000 n -0000133847 00000 n -0000133908 00000 n -0000133969 00000 n -0000134029 00000 n -0000134090 00000 n -0000134151 00000 n -0000134211 00000 n -0000134272 00000 n -0000134333 00000 n -0000134394 00000 n -0000134455 00000 n -0000134515 00000 n -0000887459 00000 n -0000138361 00000 n -0000138641 00000 n -0000138222 00000 n -0000134659 00000 n -0000138518 00000 n -0000146737 00000 n -0000146888 00000 n -0000147593 00000 n -0000146590 00000 n -0000138751 00000 n -0000147045 00000 n -0000147226 00000 n -0000147288 00000 n -0000147349 00000 n -0000147410 00000 n -0000147471 00000 n -0000147532 00000 n -0000154669 00000 n -0000153931 00000 n -0000147703 00000 n -0000154050 00000 n -0000154112 00000 n -0000154174 00000 n -0000154235 00000 n -0000154297 00000 n -0000154359 00000 n -0000154421 00000 n -0000154483 00000 n -0000154545 00000 n -0000154607 00000 n -0000163351 00000 n -0000163750 00000 n -0000163212 00000 n -0000154779 00000 n -0000163507 00000 n -0000163688 00000 n -0000172799 00000 n -0000173260 00000 n -0000172660 00000 n -0000163860 00000 n -0000172950 00000 n -0000173012 00000 n -0000173074 00000 n -0000173136 00000 n -0000173198 00000 n -0000177267 00000 n -0000177329 00000 n -0000177087 00000 n -0000173383 00000 n -0000177206 00000 n -0000887577 00000 n -0000186804 00000 n -0000186955 00000 n -0000187104 00000 n -0000187623 00000 n -0000186649 00000 n -0000177426 00000 n -0000187256 00000 n -0000187439 00000 n -0000192181 00000 n -0000198845 00000 n -0000192303 00000 n -0000192001 00000 n -0000187759 00000 n -0000192120 00000 n -0000887078 00000 n -0000198995 00000 n -0000199144 00000 n -0000199294 00000 n -0000204965 00000 n -0000199628 00000 n -0000198682 00000 n -0000192413 00000 n -0000199444 00000 n -0000211693 00000 n -0000205357 00000 n -0000204826 00000 n -0000199751 00000 n -0000205116 00000 n -0000211841 00000 n -0000211988 00000 n -0000212381 00000 n -0000211538 00000 n -0000205467 00000 n -0000212136 00000 n -0000213409 00000 n -0000213168 00000 n -0000212478 00000 n -0000213287 00000 n -0000213348 00000 n -0000887695 00000 n -0000213953 00000 n -0000213710 00000 n -0000213493 00000 n -0000213829 00000 n -0000221237 00000 n -0000221387 00000 n -0000221534 00000 n -0000221684 00000 n -0000221834 00000 n -0000223996 00000 n -0000222167 00000 n -0000221066 00000 n -0000214037 00000 n -0000221984 00000 n -0000222105 00000 n -0000224208 00000 n -0000223857 00000 n -0000222303 00000 n -0000224146 00000 n -0000231436 00000 n -0000231586 00000 n -0000231736 00000 n -0000231887 00000 n -0000232219 00000 n -0000231273 00000 n -0000224305 00000 n -0000232036 00000 n -0000232157 00000 n -0000233233 00000 n -0000233052 00000 n -0000232368 00000 n -0000233171 00000 n -0000241012 00000 n -0000241162 00000 n -0000241312 00000 n -0000241462 00000 n -0000241793 00000 n -0000240849 00000 n -0000233317 00000 n -0000241611 00000 n -0000241732 00000 n -0000887813 00000 n -0000242807 00000 n -0000242626 00000 n -0000241942 00000 n -0000242745 00000 n -0000249629 00000 n -0000249775 00000 n -0000250109 00000 n -0000249482 00000 n -0000242891 00000 n -0000249926 00000 n -0000250047 00000 n -0000256276 00000 n -0000256425 00000 n -0000256759 00000 n -0000256129 00000 n -0000250258 00000 n -0000256574 00000 n -0000256697 00000 n -0000263289 00000 n -0000263437 00000 n -0000263771 00000 n -0000263142 00000 n -0000256908 00000 n -0000263588 00000 n -0000263709 00000 n -0000271000 00000 n -0000271149 00000 n -0000271484 00000 n -0000270853 00000 n -0000263932 00000 n -0000271298 00000 n -0000271422 00000 n -0000272508 00000 n -0000272328 00000 n -0000271645 00000 n -0000272447 00000 n -0000887931 00000 n -0000279057 00000 n -0000279206 00000 n -0000279541 00000 n -0000278910 00000 n -0000272592 00000 n -0000279356 00000 n -0000279479 00000 n -0000285544 00000 n -0000285691 00000 n -0000286025 00000 n -0000285397 00000 n -0000279690 00000 n -0000285842 00000 n -0000285963 00000 n -0000291856 00000 n -0000292004 00000 n -0000292339 00000 n -0000291709 00000 n -0000286173 00000 n -0000292154 00000 n -0000886497 00000 n -0000292277 00000 n -0000300228 00000 n -0000300379 00000 n -0000300528 00000 n -0000307923 00000 n -0000301047 00000 n -0000300073 00000 n -0000292488 00000 n -0000300678 00000 n -0000300799 00000 n -0000300861 00000 n -0000300923 00000 n -0000300985 00000 n -0000308074 00000 n -0000308224 00000 n -0000308374 00000 n -0000308526 00000 n -0000308679 00000 n -0000308832 00000 n -0000309045 00000 n -0000307736 00000 n -0000301208 00000 n -0000308983 00000 n -0000317762 00000 n -0000325272 00000 n -0000318095 00000 n -0000317623 00000 n -0000309155 00000 n -0000317912 00000 n -0000318033 00000 n -0000888049 00000 n -0000325424 00000 n -0000325575 00000 n -0000325726 00000 n -0000325876 00000 n -0000326088 00000 n -0000325101 00000 n -0000318269 00000 n -0000326026 00000 n -0000331093 00000 n -0000331244 00000 n -0000331456 00000 n -0000330946 00000 n -0000326224 00000 n -0000331395 00000 n -0000332415 00000 n -0000332691 00000 n -0000332276 00000 n -0000331566 00000 n -0000332567 00000 n -0000339012 00000 n -0000339163 00000 n -0000339314 00000 n -0000339647 00000 n -0000338857 00000 n -0000332775 00000 n -0000339464 00000 n -0000339585 00000 n -0000348337 00000 n -0000344108 00000 n -0000348487 00000 n -0000348761 00000 n -0000343961 00000 n -0000339783 00000 n -0000348637 00000 n +0000028556 00000 n +0000028713 00000 n +0000028869 00000 n +0000029019 00000 n +0000029176 00000 n +0000029338 00000 n +0000029495 00000 n +0000029657 00000 n +0000029812 00000 n +0000029974 00000 n +0000030131 00000 n +0000030288 00000 n +0000030440 00000 n +0000030592 00000 n +0000030745 00000 n +0000030898 00000 n +0000031051 00000 n +0000031204 00000 n +0000031357 00000 n +0000031510 00000 n +0000031664 00000 n +0000031818 00000 n +0000031968 00000 n +0000032121 00000 n +0000032275 00000 n +0000032429 00000 n +0000032583 00000 n +0000032737 00000 n +0000032891 00000 n +0000033045 00000 n +0000033199 00000 n +0000033353 00000 n +0000033507 00000 n +0000033660 00000 n +0000033814 00000 n +0000033965 00000 n +0000034119 00000 n +0000034273 00000 n +0000034426 00000 n +0000056270 00000 n +0000034701 00000 n +0000027466 00000 n +0000010796 00000 n +0000034579 00000 n +0000034640 00000 n +0000056421 00000 n +0000056574 00000 n +0000056728 00000 n +0000056882 00000 n +0000057036 00000 n +0000057190 00000 n +0000057344 00000 n +0000057498 00000 n +0000057652 00000 n +0000057805 00000 n +0000057958 00000 n +0000058112 00000 n +0000058266 00000 n +0000058419 00000 n +0000058572 00000 n +0000058725 00000 n +0000058879 00000 n +0000059033 00000 n +0000059187 00000 n +0000059341 00000 n +0000059495 00000 n +0000059649 00000 n +0000059803 00000 n +0000059956 00000 n +0000060108 00000 n +0000060262 00000 n +0000060416 00000 n +0000060570 00000 n +0000060722 00000 n +0000060876 00000 n +0000061030 00000 n +0000061184 00000 n +0000061338 00000 n +0000061492 00000 n +0000061646 00000 n +0000061800 00000 n +0000061954 00000 n +0000062108 00000 n +0000062262 00000 n +0000062416 00000 n +0000062570 00000 n +0000062724 00000 n +0000062878 00000 n +0000063031 00000 n +0000070782 00000 n +0000070933 00000 n +0000071086 00000 n +0000071240 00000 n +0000063246 00000 n +0000055779 00000 n +0000034798 00000 n +0000063184 00000 n +0000071393 00000 n +0000071547 00000 n +0000071698 00000 n +0000071851 00000 n +0000072005 00000 n +0000072158 00000 n +0000072312 00000 n +0000072466 00000 n +0000072616 00000 n +0000072770 00000 n +0000072924 00000 n +0000073078 00000 n +0000073232 00000 n +0000073383 00000 n +0000073597 00000 n +0000070507 00000 n +0000063330 00000 n +0000073536 00000 n +0000074000 00000 n +0000073819 00000 n +0000073681 00000 n +0000073938 00000 n +0000082397 00000 n +0000082552 00000 n +0000082708 00000 n +0000082862 00000 n +0000083017 00000 n +0000083167 00000 n +0000083319 00000 n +0000090948 00000 n +0000091099 00000 n +0000083531 00000 n +0000082210 00000 n +0000074071 00000 n +0000904682 00000 n +0000905383 00000 n +0000763052 00000 n +0000762989 00000 n +0000760853 00000 n +0000760915 00000 n +0000761165 00000 n +0000760668 00000 n +0000760730 00000 n +0000091252 00000 n +0000089288 00000 n +0000091527 00000 n +0000089133 00000 n +0000083628 00000 n +0000903238 00000 n +0000091465 00000 n +0000090686 00000 n +0000090805 00000 n +0000090852 00000 n +0000090926 00000 n +0000760791 00000 n +0000101113 00000 n +0000101266 00000 n +0000101420 00000 n +0000101818 00000 n +0000100958 00000 n +0000091652 00000 n +0000101573 00000 n +0000904974 00000 n +0000903963 00000 n +0000903530 00000 n +0000904394 00000 n +0000903820 00000 n +0000101694 00000 n +0000904106 00000 n +0000101756 00000 n +0000761103 00000 n +0000109451 00000 n +0000109604 00000 n +0000107480 00000 n +0000109942 00000 n +0000107333 00000 n +0000102018 00000 n +0000109757 00000 n +0000109819 00000 n +0000109189 00000 n +0000109308 00000 n +0000109355 00000 n +0000109429 00000 n +0000760606 00000 n +0000760545 00000 n +0000115984 00000 n +0000116135 00000 n +0000116348 00000 n +0000115837 00000 n +0000110106 00000 n +0000116287 00000 n +0000125912 00000 n +0000125174 00000 n +0000116458 00000 n +0000125293 00000 n +0000903384 00000 n +0000125416 00000 n +0000125478 00000 n +0000125540 00000 n +0000125602 00000 n +0000125664 00000 n +0000125726 00000 n +0000125788 00000 n +0000125850 00000 n +0000133971 00000 n +0000133002 00000 n +0000126047 00000 n +0000133121 00000 n +0000133182 00000 n +0000133243 00000 n +0000133304 00000 n +0000133365 00000 n +0000133425 00000 n +0000133486 00000 n +0000133547 00000 n +0000133607 00000 n +0000133668 00000 n +0000133729 00000 n +0000133790 00000 n +0000133851 00000 n +0000133911 00000 n +0000905501 00000 n +0000137757 00000 n +0000138037 00000 n +0000137618 00000 n +0000134055 00000 n +0000137914 00000 n +0000146133 00000 n +0000146284 00000 n +0000146989 00000 n +0000145986 00000 n +0000138147 00000 n +0000146441 00000 n +0000146622 00000 n +0000146684 00000 n +0000146745 00000 n +0000146806 00000 n +0000146867 00000 n +0000146928 00000 n +0000154065 00000 n +0000153327 00000 n +0000147099 00000 n +0000153446 00000 n +0000153508 00000 n +0000153570 00000 n +0000153631 00000 n +0000153693 00000 n +0000153755 00000 n +0000153817 00000 n +0000153879 00000 n +0000153941 00000 n +0000154003 00000 n +0000162747 00000 n +0000163146 00000 n +0000162608 00000 n +0000154175 00000 n +0000162903 00000 n +0000163084 00000 n +0000172195 00000 n +0000172656 00000 n +0000172056 00000 n +0000163256 00000 n +0000172346 00000 n +0000172408 00000 n +0000172470 00000 n +0000172532 00000 n +0000172594 00000 n +0000198761 00000 n +0000176725 00000 n +0000176483 00000 n +0000172779 00000 n +0000176602 00000 n +0000176663 00000 n +0000905619 00000 n +0000184930 00000 n +0000184566 00000 n +0000176822 00000 n +0000184685 00000 n +0000184869 00000 n +0000194265 00000 n +0000194721 00000 n +0000194126 00000 n +0000185040 00000 n +0000194416 00000 n +0000194477 00000 n +0000194538 00000 n +0000194599 00000 n +0000194660 00000 n +0000198883 00000 n +0000198580 00000 n +0000194844 00000 n +0000198699 00000 n +0000207234 00000 n +0000207385 00000 n +0000207536 00000 n +0000212705 00000 n +0000208049 00000 n +0000207079 00000 n +0000198980 00000 n +0000207688 00000 n +0000207809 00000 n +0000212917 00000 n +0000219525 00000 n +0000212979 00000 n +0000212566 00000 n +0000208185 00000 n +0000212855 00000 n +0000905120 00000 n +0000219677 00000 n +0000219828 00000 n +0000219979 00000 n +0000220369 00000 n +0000219362 00000 n +0000213089 00000 n +0000220129 00000 n +0000905737 00000 n +0000225773 00000 n +0000230609 00000 n +0000226165 00000 n +0000225634 00000 n +0000220505 00000 n +0000225921 00000 n +0000230757 00000 n +0000231149 00000 n +0000230462 00000 n +0000226262 00000 n +0000230906 00000 n +0000231088 00000 n +0000231706 00000 n +0000231463 00000 n +0000231246 00000 n +0000231582 00000 n +0000238990 00000 n +0000239140 00000 n +0000239287 00000 n +0000239437 00000 n +0000239587 00000 n +0000241749 00000 n +0000239920 00000 n +0000238819 00000 n +0000231790 00000 n +0000239737 00000 n +0000239858 00000 n +0000241961 00000 n +0000241610 00000 n +0000240056 00000 n +0000241899 00000 n +0000249189 00000 n +0000249339 00000 n +0000249489 00000 n +0000249640 00000 n +0000249972 00000 n +0000249026 00000 n +0000242058 00000 n +0000249789 00000 n +0000249910 00000 n +0000905855 00000 n +0000250986 00000 n +0000250805 00000 n +0000250121 00000 n +0000250924 00000 n +0000258765 00000 n +0000258915 00000 n +0000259065 00000 n +0000259215 00000 n +0000259546 00000 n +0000258602 00000 n +0000251070 00000 n +0000259364 00000 n +0000259485 00000 n +0000260560 00000 n +0000260379 00000 n +0000259695 00000 n +0000260498 00000 n +0000267382 00000 n +0000267528 00000 n +0000267862 00000 n +0000267235 00000 n +0000260644 00000 n +0000267679 00000 n +0000267800 00000 n +0000274029 00000 n +0000274178 00000 n +0000274512 00000 n +0000273882 00000 n +0000268011 00000 n +0000274327 00000 n +0000274450 00000 n +0000281042 00000 n +0000281190 00000 n +0000281524 00000 n +0000280895 00000 n +0000274661 00000 n +0000281341 00000 n +0000281462 00000 n +0000905973 00000 n +0000288753 00000 n +0000288902 00000 n +0000289237 00000 n +0000288606 00000 n +0000281685 00000 n +0000289051 00000 n +0000289175 00000 n +0000290261 00000 n +0000290081 00000 n +0000289398 00000 n +0000290200 00000 n +0000296810 00000 n +0000296959 00000 n +0000297294 00000 n +0000296663 00000 n +0000290345 00000 n +0000297109 00000 n +0000297232 00000 n +0000303297 00000 n +0000303444 00000 n +0000303778 00000 n +0000303150 00000 n +0000297443 00000 n +0000303595 00000 n +0000303716 00000 n +0000309609 00000 n +0000309757 00000 n +0000310092 00000 n +0000309462 00000 n +0000303926 00000 n +0000309907 00000 n +0000904539 00000 n +0000310030 00000 n +0000317981 00000 n +0000318132 00000 n +0000318281 00000 n +0000325676 00000 n +0000318800 00000 n +0000317826 00000 n +0000310241 00000 n +0000318431 00000 n +0000318552 00000 n +0000318614 00000 n +0000318676 00000 n +0000318738 00000 n +0000906091 00000 n +0000325827 00000 n +0000325977 00000 n +0000326127 00000 n +0000326279 00000 n +0000326432 00000 n +0000326585 00000 n +0000326798 00000 n +0000325489 00000 n +0000318961 00000 n +0000326736 00000 n +0000335515 00000 n +0000343025 00000 n +0000335848 00000 n +0000335376 00000 n +0000326908 00000 n +0000335665 00000 n +0000335786 00000 n +0000343177 00000 n +0000343328 00000 n +0000343479 00000 n +0000343629 00000 n +0000343841 00000 n +0000342854 00000 n +0000336022 00000 n +0000343779 00000 n +0000348846 00000 n +0000348997 00000 n +0000349209 00000 n 0000348699 00000 n -0000348002 00000 n -0000348121 00000 n -0000348168 00000 n -0000348242 00000 n -0000348315 00000 n -0000352201 00000 n -0000352021 00000 n -0000348912 00000 n -0000352140 00000 n -0000886208 00000 n -0000888167 00000 n -0000359484 00000 n -0000359635 00000 n -0000359970 00000 n -0000359337 00000 n -0000352285 00000 n -0000359785 00000 n -0000359908 00000 n -0000366199 00000 n -0000371497 00000 n -0000366350 00000 n -0000366499 00000 n -0000366893 00000 n -0000366044 00000 n -0000360119 00000 n -0000366650 00000 n -0000366711 00000 n -0000366772 00000 n -0000366833 00000 n -0000375871 00000 n -0000370888 00000 n -0000370707 00000 n -0000367029 00000 n -0000370826 00000 n -0000375933 00000 n -0000371378 00000 n -0000370972 00000 n -0000375810 00000 n -0000375475 00000 n -0000375594 00000 n -0000375641 00000 n -0000375715 00000 n -0000375788 00000 n -0000383826 00000 n -0000383977 00000 n -0000384312 00000 n -0000383679 00000 n -0000376032 00000 n -0000384127 00000 n -0000384250 00000 n -0000386067 00000 n -0000385887 00000 n -0000384473 00000 n -0000386006 00000 n -0000888285 00000 n -0000393560 00000 n -0000395973 00000 n -0000393896 00000 n -0000393421 00000 n -0000386151 00000 n -0000393710 00000 n -0000393834 00000 n -0000396185 00000 n -0000395834 00000 n -0000394057 00000 n -0000396124 00000 n -0000403175 00000 n -0000402870 00000 n -0000396282 00000 n -0000402989 00000 n -0000409849 00000 n -0000410122 00000 n -0000409710 00000 n -0000403311 00000 n -0000410000 00000 n -0000410061 00000 n -0000420812 00000 n -0000420318 00000 n -0000410232 00000 n -0000420437 00000 n -0000420499 00000 n -0000420561 00000 n -0000420623 00000 n -0000420686 00000 n -0000420749 00000 n -0000421764 00000 n -0000421515 00000 n -0000420948 00000 n -0000421638 00000 n -0000421701 00000 n -0000888403 00000 n -0000427628 00000 n -0000428031 00000 n -0000427484 00000 n -0000421849 00000 n -0000427779 00000 n -0000427905 00000 n -0000427969 00000 n -0000431862 00000 n -0000432013 00000 n -0000432352 00000 n -0000431709 00000 n -0000428155 00000 n -0000432165 00000 n -0000432289 00000 n -0000435954 00000 n -0000436104 00000 n -0000436381 00000 n -0000435801 00000 n -0000432463 00000 n -0000436255 00000 n -0000438939 00000 n -0000439214 00000 n -0000438795 00000 n -0000436492 00000 n -0000439090 00000 n -0000445453 00000 n -0000445601 00000 n -0000445879 00000 n -0000445300 00000 n -0000439325 00000 n -0000445752 00000 n -0000447979 00000 n -0000447667 00000 n -0000446016 00000 n -0000447790 00000 n -0000447853 00000 n -0000447916 00000 n -0000888528 00000 n -0000453163 00000 n -0000453313 00000 n -0000453778 00000 n -0000453010 00000 n -0000448064 00000 n -0000453460 00000 n -0000453586 00000 n -0000453650 00000 n -0000453714 00000 n -0000460796 00000 n -0000460947 00000 n -0000461097 00000 n -0000461372 00000 n -0000460634 00000 n -0000453902 00000 n -0000461248 00000 n -0000465141 00000 n -0000464570 00000 n -0000461496 00000 n -0000464693 00000 n -0000464757 00000 n -0000464821 00000 n -0000464885 00000 n -0000464949 00000 n -0000465013 00000 n -0000465077 00000 n -0000471450 00000 n -0000471602 00000 n -0000472003 00000 n -0000471297 00000 n -0000465252 00000 n -0000471752 00000 n -0000471877 00000 n -0000471940 00000 n -0000474073 00000 n -0000473694 00000 n -0000472114 00000 n -0000473817 00000 n -0000473881 00000 n -0000473945 00000 n -0000474009 00000 n -0000477456 00000 n -0000477605 00000 n -0000477881 00000 n -0000477303 00000 n -0000474158 00000 n -0000477757 00000 n -0000888653 00000 n -0000482180 00000 n -0000482329 00000 n -0000482671 00000 n -0000482027 00000 n -0000477992 00000 n -0000482480 00000 n -0000482607 00000 n -0000487589 00000 n -0000487863 00000 n -0000487445 00000 n -0000482782 00000 n -0000487739 00000 n -0000494367 00000 n -0000494644 00000 n -0000494223 00000 n -0000487987 00000 n -0000494518 00000 n -0000495694 00000 n -0000495382 00000 n -0000494768 00000 n -0000495505 00000 n -0000495568 00000 n -0000495631 00000 n -0000498860 00000 n -0000499137 00000 n -0000498716 00000 n -0000495779 00000 n -0000499011 00000 n -0000502333 00000 n -0000502608 00000 n -0000502189 00000 n -0000499248 00000 n -0000502484 00000 n -0000888778 00000 n -0000506466 00000 n -0000506217 00000 n -0000502719 00000 n -0000506340 00000 n -0000513347 00000 n -0000513622 00000 n -0000513203 00000 n -0000506603 00000 n -0000513498 00000 n -0000514826 00000 n -0000514511 00000 n -0000513746 00000 n -0000514634 00000 n -0000514698 00000 n -0000514762 00000 n -0000520836 00000 n -0000521112 00000 n -0000520692 00000 n -0000514911 00000 n -0000520988 00000 n -0000524712 00000 n -0000525053 00000 n -0000524568 00000 n -0000521236 00000 n -0000524863 00000 n -0000524989 00000 n -0000530353 00000 n -0000530692 00000 n -0000530209 00000 n -0000525177 00000 n -0000530505 00000 n -0000530629 00000 n -0000888903 00000 n -0000534260 00000 n -0000534601 00000 n -0000534116 00000 n -0000530816 00000 n -0000534411 00000 n -0000534537 00000 n -0000539885 00000 n -0000540224 00000 n -0000539741 00000 n -0000534725 00000 n -0000540037 00000 n -0000540161 00000 n -0000544356 00000 n -0000544760 00000 n -0000544212 00000 n -0000540348 00000 n -0000544506 00000 n -0000544632 00000 n -0000544696 00000 n -0000548729 00000 n -0000549130 00000 n -0000548585 00000 n -0000544871 00000 n -0000548880 00000 n -0000549004 00000 n -0000549067 00000 n -0000555235 00000 n -0000555511 00000 n -0000555091 00000 n -0000549241 00000 n -0000555384 00000 n -0000559771 00000 n -0000559396 00000 n -0000555635 00000 n -0000559519 00000 n -0000559582 00000 n -0000559645 00000 n -0000559708 00000 n -0000889028 00000 n -0000564242 00000 n -0000564391 00000 n -0000564542 00000 n -0000564818 00000 n -0000564080 00000 n -0000559895 00000 n -0000564692 00000 n -0000571004 00000 n -0000570756 00000 n -0000564942 00000 n -0000570879 00000 n -0000578970 00000 n -0000578208 00000 n -0000571128 00000 n -0000578331 00000 n -0000578395 00000 n -0000578459 00000 n -0000578523 00000 n -0000578587 00000 n -0000578651 00000 n -0000578715 00000 n -0000578778 00000 n -0000578842 00000 n -0000578906 00000 n -0000579582 00000 n -0000579334 00000 n -0000579093 00000 n -0000579457 00000 n -0000585677 00000 n -0000585300 00000 n -0000579667 00000 n -0000585423 00000 n -0000585549 00000 n -0000585613 00000 n -0000590893 00000 n -0000590520 00000 n -0000585814 00000 n -0000590643 00000 n -0000590768 00000 n -0000590830 00000 n -0000889153 00000 n -0000595885 00000 n -0000595444 00000 n -0000591030 00000 n -0000595567 00000 n -0000595693 00000 n -0000595757 00000 n -0000595821 00000 n -0000598489 00000 n -0000598242 00000 n -0000596022 00000 n -0000598365 00000 n -0000601933 00000 n -0000601684 00000 n -0000598600 00000 n -0000601807 00000 n -0000603557 00000 n -0000603310 00000 n -0000602070 00000 n -0000603433 00000 n -0000605450 00000 n -0000605201 00000 n -0000603668 00000 n -0000605324 00000 n -0000607227 00000 n -0000606980 00000 n -0000605561 00000 n -0000607103 00000 n -0000889278 00000 n -0000612179 00000 n -0000611930 00000 n -0000607338 00000 n -0000612053 00000 n -0000617895 00000 n -0000617522 00000 n -0000612316 00000 n -0000617645 00000 n -0000617769 00000 n -0000617832 00000 n -0000623654 00000 n -0000623277 00000 n -0000618032 00000 n -0000623400 00000 n -0000623526 00000 n -0000623590 00000 n -0000629384 00000 n -0000629011 00000 n -0000623791 00000 n -0000629134 00000 n -0000629258 00000 n -0000629321 00000 n -0000635235 00000 n -0000634858 00000 n -0000629521 00000 n -0000634981 00000 n -0000635107 00000 n -0000635171 00000 n -0000641053 00000 n -0000640680 00000 n -0000635372 00000 n -0000640803 00000 n -0000640927 00000 n -0000640990 00000 n -0000889403 00000 n -0000646931 00000 n -0000646619 00000 n -0000641190 00000 n -0000646742 00000 n -0000646868 00000 n -0000652789 00000 n -0000652480 00000 n -0000647068 00000 n -0000652603 00000 n -0000652727 00000 n -0000659545 00000 n -0000659695 00000 n -0000659973 00000 n -0000659392 00000 n -0000652926 00000 n -0000659846 00000 n -0000664176 00000 n -0000664240 00000 n -0000664304 00000 n -0000663990 00000 n -0000660071 00000 n -0000664113 00000 n -0000667669 00000 n -0000667420 00000 n -0000664402 00000 n -0000667543 00000 n -0000669239 00000 n -0000668991 00000 n -0000667780 00000 n -0000669114 00000 n -0000889528 00000 n -0000670909 00000 n -0000670659 00000 n -0000669350 00000 n -0000670782 00000 n -0000673038 00000 n -0000672790 00000 n -0000671020 00000 n -0000672913 00000 n -0000673985 00000 n -0000673735 00000 n -0000673149 00000 n -0000673858 00000 n -0000678729 00000 n -0000679004 00000 n -0000678585 00000 n -0000674083 00000 n -0000678879 00000 n -0000684187 00000 n -0000684463 00000 n -0000684043 00000 n -0000679115 00000 n -0000684336 00000 n -0000688012 00000 n -0000688287 00000 n -0000687868 00000 n -0000684574 00000 n -0000688162 00000 n -0000889653 00000 n -0000691971 00000 n -0000691721 00000 n -0000688398 00000 n -0000691844 00000 n -0000695996 00000 n -0000696271 00000 n -0000695852 00000 n -0000692082 00000 n -0000696146 00000 n -0000697604 00000 n -0000697354 00000 n -0000696382 00000 n -0000697477 00000 n -0000702570 00000 n -0000702722 00000 n -0000703064 00000 n -0000702417 00000 n -0000697715 00000 n -0000702877 00000 n -0000703001 00000 n -0000708180 00000 n -0000708329 00000 n -0000708479 00000 n -0000708631 00000 n -0000708908 00000 n -0000708009 00000 n -0000703226 00000 n -0000708782 00000 n -0000714233 00000 n -0000714384 00000 n -0000714660 00000 n -0000714080 00000 n -0000709019 00000 n -0000714536 00000 n -0000889778 00000 n -0000716971 00000 n -0000717250 00000 n -0000716827 00000 n -0000714771 00000 n -0000717123 00000 n -0000718267 00000 n -0000718019 00000 n -0000717361 00000 n -0000718142 00000 n -0000725790 00000 n -0000725939 00000 n -0000726215 00000 n -0000725637 00000 n -0000718365 00000 n -0000726089 00000 n -0000732270 00000 n -0000732485 00000 n -0000732126 00000 n -0000726377 00000 n -0000732422 00000 n -0000735340 00000 n -0000735153 00000 n -0000732609 00000 n -0000735276 00000 n -0000743424 00000 n -0000742430 00000 n -0000735438 00000 n -0000742553 00000 n -0000742616 00000 n -0000742679 00000 n -0000743174 00000 n -0000743237 00000 n -0000889903 00000 n -0000745376 00000 n -0000744999 00000 n -0000743535 00000 n -0000745122 00000 n -0000745312 00000 n -0000745461 00000 n -0000745914 00000 n -0000746248 00000 n -0000746604 00000 n -0000746630 00000 n -0000747141 00000 n -0000747179 00000 n -0000747874 00000 n -0000748231 00000 n -0000748311 00000 n -0000748687 00000 n -0000749329 00000 n -0000749993 00000 n -0000750621 00000 n -0000751264 00000 n -0000751554 00000 n -0000752207 00000 n -0000766344 00000 n -0000766791 00000 n -0000779190 00000 n -0000779618 00000 n -0000790725 00000 n -0000791060 00000 n -0000793146 00000 n -0000793368 00000 n -0000797927 00000 n -0000798174 00000 n -0000814913 00000 n -0000815446 00000 n -0000817722 00000 n -0000817954 00000 n -0000820337 00000 n -0000820575 00000 n -0000830257 00000 n -0000830634 00000 n -0000836624 00000 n -0000836944 00000 n -0000840994 00000 n -0000841338 00000 n -0000842961 00000 n -0000843197 00000 n -0000856707 00000 n -0000857083 00000 n -0000863356 00000 n -0000863624 00000 n -0000877084 00000 n -0000877570 00000 n -0000884558 00000 n -0000889992 00000 n -0000890112 00000 n -0000890234 00000 n -0000890360 00000 n -0000890477 00000 n -0000890569 00000 n -0000900388 00000 n -0000900575 00000 n -0000900760 00000 n -0000900943 00000 n -0000901119 00000 n -0000901289 00000 n -0000901460 00000 n -0000901630 00000 n -0000901801 00000 n -0000901971 00000 n -0000902145 00000 n -0000902320 00000 n -0000902497 00000 n -0000902671 00000 n -0000902845 00000 n -0000903022 00000 n -0000903197 00000 n -0000903374 00000 n -0000903549 00000 n -0000903726 00000 n -0000903914 00000 n -0000904131 00000 n -0000904334 00000 n -0000904521 00000 n -0000904702 00000 n -0000904880 00000 n -0000905065 00000 n -0000905247 00000 n -0000905429 00000 n -0000905614 00000 n -0000905792 00000 n -0000905962 00000 n -0000906133 00000 n -0000906303 00000 n -0000906474 00000 n -0000906644 00000 n -0000906815 00000 n -0000906985 00000 n -0000907161 00000 n -0000907335 00000 n -0000907509 00000 n -0000907686 00000 n -0000907861 00000 n -0000908038 00000 n -0000908213 00000 n -0000908390 00000 n -0000908563 00000 n -0000908757 00000 n -0000908960 00000 n -0000909160 00000 n -0000909360 00000 n -0000909563 00000 n -0000909764 00000 n -0000909967 00000 n -0000910168 00000 n -0000910371 00000 n -0000910572 00000 n -0000910775 00000 n -0000910976 00000 n -0000911179 00000 n -0000911379 00000 n -0000911571 00000 n -0000911757 00000 n -0000911962 00000 n -0000912198 00000 n -0000912375 00000 n -0000912549 00000 n -0000912700 00000 n -0000912818 00000 n -0000912934 00000 n -0000913049 00000 n -0000913166 00000 n -0000913281 00000 n -0000913397 00000 n -0000913513 00000 n -0000913633 00000 n -0000913756 00000 n -0000913880 00000 n -0000914000 00000 n -0000914071 00000 n -0000914189 00000 n -0000914305 00000 n -0000914387 00000 n -0000914427 00000 n -0000914664 00000 n +0000343977 00000 n +0000349148 00000 n +0000350168 00000 n +0000350444 00000 n +0000350029 00000 n +0000349319 00000 n +0000350320 00000 n +0000356765 00000 n +0000356916 00000 n +0000357067 00000 n +0000357400 00000 n +0000356610 00000 n +0000350528 00000 n +0000357217 00000 n +0000357338 00000 n +0000906209 00000 n +0000366090 00000 n +0000361861 00000 n +0000366240 00000 n +0000366514 00000 n +0000361714 00000 n +0000357536 00000 n +0000366390 00000 n +0000366452 00000 n +0000365755 00000 n +0000365874 00000 n +0000365921 00000 n +0000365995 00000 n +0000366068 00000 n +0000369954 00000 n +0000369774 00000 n +0000366665 00000 n +0000369893 00000 n +0000904250 00000 n +0000377237 00000 n +0000377388 00000 n +0000377723 00000 n +0000377090 00000 n +0000370038 00000 n +0000377538 00000 n +0000377661 00000 n +0000383952 00000 n +0000389250 00000 n +0000384103 00000 n +0000384252 00000 n +0000384646 00000 n +0000383797 00000 n +0000377872 00000 n +0000384403 00000 n +0000384464 00000 n +0000384525 00000 n +0000384586 00000 n +0000393624 00000 n +0000388641 00000 n +0000388460 00000 n +0000384782 00000 n +0000388579 00000 n +0000393686 00000 n +0000389131 00000 n +0000388725 00000 n +0000393563 00000 n +0000906327 00000 n +0000393228 00000 n +0000393347 00000 n +0000393394 00000 n +0000393468 00000 n +0000393541 00000 n +0000401579 00000 n +0000401730 00000 n +0000402065 00000 n +0000401432 00000 n +0000393785 00000 n +0000401880 00000 n +0000402003 00000 n +0000403820 00000 n +0000403640 00000 n +0000402226 00000 n +0000403759 00000 n +0000411317 00000 n +0000413740 00000 n +0000411658 00000 n +0000411175 00000 n +0000403904 00000 n +0000411467 00000 n +0000411594 00000 n +0000413954 00000 n +0000413598 00000 n +0000411820 00000 n +0000413891 00000 n +0000420953 00000 n +0000420641 00000 n +0000414052 00000 n +0000420763 00000 n +0000427634 00000 n +0000427912 00000 n +0000427490 00000 n +0000421090 00000 n +0000427786 00000 n +0000427849 00000 n +0000906448 00000 n +0000438617 00000 n +0000438110 00000 n +0000428023 00000 n +0000438233 00000 n +0000438297 00000 n +0000438361 00000 n +0000438425 00000 n +0000438489 00000 n +0000438553 00000 n +0000439570 00000 n +0000439321 00000 n +0000438754 00000 n +0000439444 00000 n +0000439507 00000 n +0000445434 00000 n +0000445837 00000 n +0000445290 00000 n +0000439655 00000 n +0000445585 00000 n +0000445711 00000 n +0000445775 00000 n +0000449668 00000 n +0000449819 00000 n +0000450158 00000 n +0000449515 00000 n +0000445961 00000 n +0000449971 00000 n +0000450095 00000 n +0000453760 00000 n +0000453910 00000 n +0000454187 00000 n +0000453607 00000 n +0000450269 00000 n +0000454061 00000 n +0000456745 00000 n +0000457020 00000 n +0000456601 00000 n +0000454298 00000 n +0000456896 00000 n +0000906573 00000 n +0000463259 00000 n +0000463407 00000 n +0000463685 00000 n +0000463106 00000 n +0000457131 00000 n +0000463558 00000 n +0000465785 00000 n +0000465473 00000 n +0000463822 00000 n +0000465596 00000 n +0000465659 00000 n +0000465722 00000 n +0000470969 00000 n +0000471119 00000 n +0000471584 00000 n +0000470816 00000 n +0000465870 00000 n +0000471266 00000 n +0000471392 00000 n +0000471456 00000 n +0000471520 00000 n +0000478602 00000 n +0000478753 00000 n +0000478903 00000 n +0000479178 00000 n +0000478440 00000 n +0000471708 00000 n +0000479054 00000 n +0000482947 00000 n +0000482376 00000 n +0000479302 00000 n +0000482499 00000 n +0000482563 00000 n +0000482627 00000 n +0000482691 00000 n +0000482755 00000 n +0000482819 00000 n +0000482883 00000 n +0000489256 00000 n +0000489408 00000 n +0000489809 00000 n +0000489103 00000 n +0000483058 00000 n +0000489558 00000 n +0000489683 00000 n +0000489746 00000 n +0000906698 00000 n +0000491879 00000 n +0000491500 00000 n +0000489920 00000 n +0000491623 00000 n +0000491687 00000 n +0000491751 00000 n +0000491815 00000 n +0000495262 00000 n +0000495411 00000 n +0000495687 00000 n +0000495109 00000 n +0000491964 00000 n +0000495563 00000 n +0000499986 00000 n +0000500135 00000 n +0000500477 00000 n +0000499833 00000 n +0000495798 00000 n +0000500286 00000 n +0000500413 00000 n +0000505395 00000 n +0000505669 00000 n +0000505251 00000 n +0000500588 00000 n +0000505545 00000 n +0000512173 00000 n +0000512450 00000 n +0000512029 00000 n +0000505793 00000 n +0000512324 00000 n +0000513500 00000 n +0000513188 00000 n +0000512574 00000 n +0000513311 00000 n +0000513374 00000 n +0000513437 00000 n +0000906823 00000 n +0000516666 00000 n +0000516943 00000 n +0000516522 00000 n +0000513585 00000 n +0000516817 00000 n +0000520139 00000 n +0000520414 00000 n +0000519995 00000 n +0000517054 00000 n +0000520290 00000 n +0000524272 00000 n +0000524023 00000 n +0000520525 00000 n +0000524146 00000 n +0000531153 00000 n +0000531428 00000 n +0000531009 00000 n +0000524409 00000 n +0000531304 00000 n +0000532632 00000 n +0000532317 00000 n +0000531552 00000 n +0000532440 00000 n +0000532504 00000 n +0000532568 00000 n +0000538642 00000 n +0000538918 00000 n +0000538498 00000 n +0000532717 00000 n +0000538794 00000 n +0000906948 00000 n +0000542518 00000 n +0000542859 00000 n +0000542374 00000 n +0000539042 00000 n +0000542669 00000 n +0000542795 00000 n +0000548159 00000 n +0000548498 00000 n +0000548015 00000 n +0000542983 00000 n +0000548311 00000 n +0000548435 00000 n +0000552066 00000 n +0000552407 00000 n +0000551922 00000 n +0000548622 00000 n +0000552217 00000 n +0000552343 00000 n +0000557691 00000 n +0000558030 00000 n +0000557547 00000 n +0000552531 00000 n +0000557843 00000 n +0000557967 00000 n +0000562162 00000 n +0000562566 00000 n +0000562018 00000 n +0000558154 00000 n +0000562312 00000 n +0000562438 00000 n +0000562502 00000 n +0000566535 00000 n +0000566936 00000 n +0000566391 00000 n +0000562677 00000 n +0000566686 00000 n +0000566810 00000 n +0000566873 00000 n +0000907073 00000 n +0000573041 00000 n +0000573317 00000 n +0000572897 00000 n +0000567047 00000 n +0000573190 00000 n +0000577577 00000 n +0000577202 00000 n +0000573441 00000 n +0000577325 00000 n +0000577388 00000 n +0000577451 00000 n +0000577514 00000 n +0000582048 00000 n +0000582197 00000 n +0000582348 00000 n +0000582624 00000 n +0000581886 00000 n +0000577701 00000 n +0000582498 00000 n +0000588810 00000 n +0000588562 00000 n +0000582748 00000 n +0000588685 00000 n +0000596776 00000 n +0000596014 00000 n +0000588934 00000 n +0000596137 00000 n +0000596201 00000 n +0000596265 00000 n +0000596329 00000 n +0000596393 00000 n +0000596457 00000 n +0000596521 00000 n +0000596584 00000 n +0000596648 00000 n +0000596712 00000 n +0000597388 00000 n +0000597140 00000 n +0000596899 00000 n +0000597263 00000 n +0000907198 00000 n +0000603483 00000 n +0000603106 00000 n +0000597473 00000 n +0000603229 00000 n +0000603355 00000 n +0000603419 00000 n +0000608699 00000 n +0000608326 00000 n +0000603620 00000 n +0000608449 00000 n +0000608574 00000 n +0000608636 00000 n +0000613691 00000 n +0000613250 00000 n +0000608836 00000 n +0000613373 00000 n +0000613499 00000 n +0000613563 00000 n +0000613627 00000 n +0000616295 00000 n +0000616048 00000 n +0000613828 00000 n +0000616171 00000 n +0000619739 00000 n +0000619490 00000 n +0000616406 00000 n +0000619613 00000 n +0000621363 00000 n +0000621116 00000 n +0000619876 00000 n +0000621239 00000 n +0000907323 00000 n +0000623256 00000 n +0000623007 00000 n +0000621474 00000 n +0000623130 00000 n +0000625033 00000 n +0000624786 00000 n +0000623367 00000 n +0000624909 00000 n +0000629986 00000 n +0000629737 00000 n +0000625144 00000 n +0000629860 00000 n +0000635702 00000 n +0000635329 00000 n +0000630123 00000 n +0000635452 00000 n +0000635576 00000 n +0000635639 00000 n +0000641461 00000 n +0000641084 00000 n +0000635839 00000 n +0000641207 00000 n +0000641333 00000 n +0000641397 00000 n +0000647191 00000 n +0000646818 00000 n +0000641598 00000 n +0000646941 00000 n +0000647065 00000 n +0000647128 00000 n +0000907448 00000 n +0000653042 00000 n +0000652665 00000 n +0000647328 00000 n +0000652788 00000 n +0000652914 00000 n +0000652978 00000 n +0000658860 00000 n +0000658487 00000 n +0000653179 00000 n +0000658610 00000 n +0000658734 00000 n +0000658797 00000 n +0000664738 00000 n +0000664426 00000 n +0000658997 00000 n +0000664549 00000 n +0000664675 00000 n +0000670596 00000 n +0000670287 00000 n +0000664875 00000 n +0000670410 00000 n +0000670534 00000 n +0000677353 00000 n +0000677503 00000 n +0000677782 00000 n +0000677200 00000 n +0000670733 00000 n +0000677655 00000 n +0000681979 00000 n +0000682043 00000 n +0000682107 00000 n +0000681793 00000 n +0000677880 00000 n +0000681916 00000 n +0000907573 00000 n +0000685472 00000 n +0000685223 00000 n +0000682205 00000 n +0000685346 00000 n +0000687042 00000 n +0000686794 00000 n +0000685583 00000 n +0000686917 00000 n +0000688712 00000 n +0000688462 00000 n +0000687153 00000 n +0000688585 00000 n +0000690841 00000 n +0000690593 00000 n +0000688823 00000 n +0000690716 00000 n +0000691788 00000 n +0000691538 00000 n +0000690952 00000 n +0000691661 00000 n +0000696532 00000 n +0000696807 00000 n +0000696388 00000 n +0000691886 00000 n +0000696682 00000 n +0000907698 00000 n +0000701990 00000 n +0000702266 00000 n +0000701846 00000 n +0000696918 00000 n +0000702139 00000 n +0000705815 00000 n +0000706090 00000 n +0000705671 00000 n +0000702377 00000 n +0000705965 00000 n +0000709774 00000 n +0000709524 00000 n +0000706201 00000 n +0000709647 00000 n +0000713799 00000 n +0000714074 00000 n +0000713655 00000 n +0000709885 00000 n +0000713949 00000 n +0000715407 00000 n +0000715157 00000 n +0000714185 00000 n +0000715280 00000 n +0000720373 00000 n +0000720525 00000 n +0000720867 00000 n +0000720220 00000 n +0000715518 00000 n +0000720680 00000 n +0000720804 00000 n +0000907823 00000 n +0000725983 00000 n +0000726132 00000 n +0000726282 00000 n +0000726434 00000 n +0000726711 00000 n +0000725812 00000 n +0000721029 00000 n +0000726585 00000 n +0000732036 00000 n +0000732187 00000 n +0000732463 00000 n +0000731883 00000 n +0000726822 00000 n +0000732339 00000 n +0000734774 00000 n +0000735053 00000 n +0000734630 00000 n +0000732574 00000 n +0000734926 00000 n +0000736070 00000 n +0000735822 00000 n +0000735164 00000 n +0000735945 00000 n +0000743593 00000 n +0000743742 00000 n +0000744018 00000 n +0000743440 00000 n +0000736168 00000 n +0000743892 00000 n +0000750073 00000 n +0000750288 00000 n +0000749929 00000 n +0000744180 00000 n +0000750225 00000 n +0000907948 00000 n +0000753143 00000 n +0000752956 00000 n +0000750412 00000 n +0000753079 00000 n +0000761227 00000 n +0000760233 00000 n +0000753241 00000 n +0000760356 00000 n +0000760419 00000 n +0000760482 00000 n +0000760977 00000 n +0000761040 00000 n +0000763179 00000 n +0000762802 00000 n +0000761338 00000 n +0000762925 00000 n +0000763115 00000 n +0000763264 00000 n +0000763717 00000 n +0000764051 00000 n +0000764407 00000 n +0000764433 00000 n +0000764944 00000 n +0000764982 00000 n +0000765677 00000 n +0000766034 00000 n +0000766114 00000 n +0000766494 00000 n +0000767136 00000 n +0000767800 00000 n +0000768428 00000 n +0000769071 00000 n +0000769361 00000 n +0000770014 00000 n +0000784151 00000 n +0000784598 00000 n +0000796997 00000 n +0000797425 00000 n +0000808532 00000 n +0000808867 00000 n +0000810953 00000 n +0000811175 00000 n +0000815734 00000 n +0000815981 00000 n +0000832720 00000 n +0000833253 00000 n +0000835529 00000 n +0000835761 00000 n +0000838144 00000 n +0000838382 00000 n +0000848064 00000 n +0000848441 00000 n +0000854431 00000 n +0000854751 00000 n +0000858801 00000 n +0000859145 00000 n +0000860768 00000 n +0000861004 00000 n +0000874514 00000 n +0000874890 00000 n +0000881163 00000 n +0000881431 00000 n +0000895118 00000 n +0000895612 00000 n +0000902600 00000 n +0000908055 00000 n +0000908175 00000 n +0000908297 00000 n +0000908423 00000 n +0000908540 00000 n +0000908632 00000 n +0000918646 00000 n +0000918833 00000 n +0000919018 00000 n +0000919201 00000 n +0000919386 00000 n +0000919557 00000 n +0000919727 00000 n +0000919898 00000 n +0000920068 00000 n +0000920239 00000 n +0000920408 00000 n +0000920580 00000 n +0000920757 00000 n +0000920932 00000 n +0000921109 00000 n +0000921284 00000 n +0000921461 00000 n +0000921636 00000 n +0000921813 00000 n +0000921988 00000 n +0000922165 00000 n +0000922360 00000 n +0000922584 00000 n +0000922785 00000 n +0000922970 00000 n +0000923146 00000 n +0000923328 00000 n +0000923510 00000 n +0000923695 00000 n +0000923878 00000 n +0000924063 00000 n +0000924243 00000 n +0000924412 00000 n +0000924583 00000 n +0000924753 00000 n +0000924924 00000 n +0000925094 00000 n +0000925265 00000 n +0000925436 00000 n +0000925613 00000 n +0000925788 00000 n +0000925965 00000 n +0000926139 00000 n +0000926313 00000 n +0000926490 00000 n +0000926665 00000 n +0000926842 00000 n +0000927017 00000 n +0000927208 00000 n +0000927411 00000 n +0000927612 00000 n +0000927815 00000 n +0000928015 00000 n +0000928215 00000 n +0000928418 00000 n +0000928619 00000 n +0000928822 00000 n +0000929023 00000 n +0000929226 00000 n +0000929427 00000 n +0000929630 00000 n +0000929831 00000 n +0000930027 00000 n +0000930212 00000 n +0000930413 00000 n +0000930634 00000 n +0000930853 00000 n +0000931031 00000 n +0000931202 00000 n +0000931313 00000 n +0000931431 00000 n +0000931547 00000 n +0000931663 00000 n +0000931780 00000 n +0000931898 00000 n +0000932015 00000 n +0000932131 00000 n +0000932251 00000 n +0000932375 00000 n +0000932499 00000 n +0000932620 00000 n +0000932708 00000 n +0000932826 00000 n +0000932940 00000 n +0000933020 00000 n +0000933060 00000 n +0000933297 00000 n trailer -<< /Size 1576 -/Root 1574 0 R -/Info 1575 0 R -/ID [<4D1C2155F0A584C3A75B8EAB29F4F311> <4D1C2155F0A584C3A75B8EAB29F4F311>] >> +<< /Size 1603 +/Root 1601 0 R +/Info 1602 0 R +/ID [ ] >> startxref -915306 +933939 %%EOF diff --git a/docs/src/datastruct.tex b/docs/src/datastruct.tex index 979326042..fa49e64d1 100644 --- a/docs/src/datastruct.tex +++ b/docs/src/datastruct.tex @@ -47,23 +47,7 @@ reader: \item[{\bf matrix\_data}] includes general information about matrix and process grid, such as the communication context, the size of the global matrix, the size of the portion of matrix stored on the current -process, and so on. %% More precisely: -%% \begin{description} -%% \item[matrix\_data[psb\_dec\_type\_\hbox{]}] Identifies the decomposition type -%% (global); the actual values are internally defined, so they should -%% never be accessed directly. -%% \item[matrix\_data[psb\_ctxt\_\hbox{]}] Communication context -%% associated with the processes comprised in the virtual parallel -%% machine (global). -%% \item[matrix\_data[psb\_m\_\hbox{]}] Total number of equations (global). -%% \item[matrix\_data[psb\_n\_\hbox{]}] Total number of variables (global). -%% \item[matrix\_data[psb\_n\_row\_\hbox{]}] Number of grid variables owned by the -%% current process (local); equivalent to the number of local rows in the -%% sparse coefficient matrix. -%% \item[matrix\_data[psb\_n\_col\_\hbox{]}] Total number of grid variables read by the -%% current process (local); equivalent to the number of local columns in -%% the sparse coefficient matrix. They include the halo. -%% \end{description} +process, and so on. Specified as: an allocatable integer array of dimension \verb|psb_mdata_size_|. \item[{\bf halo\_index}] A list of the halo and boundary elements for the current process to be exchanged with other processes; for each @@ -344,6 +328,161 @@ values: permutation data (see tools routine description). \end{description} +\subsection{Dense Vector Data Structure} +\label{sec:spmat} +The \hypertarget{vdata}{{\tt psb\_vect\_type}} data structure +contains all information about local portion of the sparse matrix and +its storage mode. Most of these fields are set by the tools +routines when inserting a new sparse matrix; the user needs only +choose, if he/she so whishes, a specific matrix storage mode. \\ +\begin{description} +\item[{\bf aspk}] Contains values of the local distributed sparse +matrix.\\ +Specified as: an allocatable array of rank one of type corresponding +to matrix entries type. +\item[{\bf ia1}] Holds integer information on distributed sparse +matrix. Actual information will depend on data format used.\\ +Specified as: an allocatable integer array of rank one. +\item[{\bf ia2}] Holds integer information on distributed sparse +matrix. Actual information will depend on data format used.\\ +Specified as: an allocatable integer array of rank one. +\item[{\bf infoa}] On entry can hold auxiliary information on distributed sparse +matrix. Actual information will depend on data format used.\\ +Specified as: an integer array of length \verb|psb_ifasize_|. +\item[{\bf fida}] Defines the format of the distributed sparse matrix.\\ +Specified as: a string of length 5 +\item[{\bf descra}] Describe the characteristic of the distributed sparse matrix.\\ +Specified as: array of character of length 9. +\item[{\bf pl}] Specifies the local row permutation of distributed sparse +matrix. If pl(1) is equal to 0, then there isn't row permutation.\\ +Specified as: an allocatable integer array of dimension equal to number of local row (matrix\_data[psb\_n\_row\_\hbox{]}) +\item[{\bf pr}] Specifies the local column permutation of distributed sparse +matrix. If PR(1) is equal to 0, then there isn't columnm permutation.\\ +Specified as: an allocatable integer array of dimension equal to number of +local row (matrix\_data[psb\_n\_col\_\hbox{]}) +\item[{\bf m}] Number of rows; if row indices are stored explicitly, +as in Coordinate Storage, should be greater than or equal to the +maximum row index actually present in the sparse matrix. +Specified as: integer variable. +\item[{\bf k}] Number of columns; if column indices are stored explicitly, +as in Coordinate Storage or Compressed Sparse Rows, should be greater +than or equal to the maximum column index actually present in the sparse matrix. +Specified as: integer variable. +\end{description} +The Fortran~95 interface for distributed sparse matrices containing +double precision real entries is defined as shown in +figure~\ref{fig:spmattype}. The definitions for single precision and +complex data are identical except for the \verb|real| declaration and +for the kind type parameter. +\begin{figure}[h!] + \begin{Sbox} + \begin{minipage}[tl]{0.85\textwidth} +\begin{verbatim} +type psb_sspmat_type + integer :: m, k + character :: fida(5) + character :: descra(10) + integer :: infoa(psb_ifa_size_) + real(psb_spk_), allocatable :: aspk(:) + integer, allocatable :: ia1(:), ia2(:) + integer, allocatable :: pr(:), pl(:) +end type psb_sspmat_type + +type psb_dspmat_type + integer :: m, k + character :: fida(5) + character :: descra(10) + integer :: infoa(psb_ifa_size_) + real(psb_dpk_), allocatable :: aspk(:) + integer, allocatable :: ia1(:), ia2(:) + integer, allocatable :: pr(:), pl(:) +end type psb_dspmat_type + +type psb_cspmat_type + integer :: m, k + character :: fida(5) + character :: descra(10) + integer :: infoa(psb_ifa_size_) + complex(psb_spk_), allocatable :: aspk(:) + integer, allocatable :: ia1(:), ia2(:) + integer, allocatable :: pr(:), pl(:) +end type psb_cspmat_type + +type psb_zspmat_type + integer :: m, k + character :: fida(5) + character :: descra(10) + integer :: infoa(psb_ifa_size_) + complex(psb_dpk_), allocatable :: aspk(:) + integer, allocatable :: ia1(:), ia2(:) + integer, allocatable :: pr(:), pl(:) +end type psb_zspmat_type + +\end{verbatim} + \end{minipage} + \end{Sbox} + \setlength{\fboxsep}{8pt} + \begin{center} + \fbox{\TheSbox} + \end{center} + \caption{\label{fig:spmattype} + The PSBLAS defined data type that + contains a sparse matrix.} +\end{figure} + +The following two cases are among the most commonly used: +\begin{description} +\item[fida=``CSR''] Compressed storage by rows. In this case the +following should hold: +\begin{enumerate} +\item \verb|ia2(i)| contains the index of the first element of row +\verb|i|; the last element of the sparse matrix is thus stored at +index $ia2(m+1)-1$. It should contain \verb|m+1| entries in +nondecreasing order (strictly increasing, if there are no empty rows). +\item \verb|ia1(j)| contains the column index and \verb|aspk(j)| +contains the corresponding coefficient value, for all $ia2(1) \le j +\le ia2(m+1)-1$. +\end{enumerate} +\item[fida=``COO''] Coordinate storage. In this case the following +should hold: +\begin{enumerate} +\item \verb|infoa(1)| contains the number of nonzero elements in the +matrix; +\item For all $1 \le j \le infoa(1)$, the coefficient, row index and +column index are stored into \verb|apsk(j)|, \verb|ia1(j)| and +\verb|ia2(j)| respectively. +\end{enumerate} +\end{description} +A sparse matrix has an associated state, which can take the following +values: +\begin{description} +\item[Build:] State entered after the first allocation, and before the + first assembly; in this state it is possible to add nonzero entries. +\item[Assembled:] State entered after the assembly; computations using + the sparse matrix, such as matrix-vector products, are only possible + in this state; +\item[Update:] State entered after a reinitalization; this is used to + handle applications in which the same sparsity pattern is used + multiple times with different coefficients. In this state it is only + possible to enter coefficients for already existing nonzero entries. +\end{description} +\subsubsection{Named Constants} +\label{sec:sp_constants} +\begin{description} +%% \item[psb\_nztotreq\_] Request to fetch the total number of nonzeroes +%% stored in a sparse matrix +%% \item[psb\_nzrowreq\_] Request to fetch the number of nonzeroes in a +%% given row in a sparse matrix +\item[psb\_dupl\_ovwrt\_] Duplicate coefficients should be overwritten + (i.e. ignore duplications) +\item[psb\_dupl\_add\_] Duplicate coefficients should be added; +\item[psb\_dupl\_err\_] Duplicate coefficients should trigger an error conditino +\item[psb\_upd\_dflt\_] Default update strategy for matrix coefficients; +\item[psb\_upd\_srch\_] Update strategy based on search into the data structure; +\item[psb\_upd\_perm\_] Update strategy based on additional + permutation data (see tools routine description). +\end{description} + \subsection{Preconditioner data structure} @@ -453,11 +592,11 @@ research. \subsection{Data structure query routines} \label{sec:dataquery} -\subsubsection*{psb\_cd\_get\_local\_rows --- Get number of local rows} -\addcontentsline{toc}{subsubsection}{psb\_cd\_get\_local\_rows } +\subsubsection*{get\_local\_rows --- Get number of local rows} +\addcontentsline{toc}{subsubsection}{get\_local\_rows } \begin{verbatim} -nr = psb_cd_get_local_rows(desc) +nr = desc%get_local_rows() \end{verbatim} \begin{description} @@ -479,11 +618,11 @@ Specified as: a structured data of type \descdata. \end{description} -\subsubsection*{psb\_cd\_get\_local\_cols --- Get number of local cols} -\addcontentsline{toc}{subsubsection}{psb\_cd\_get\_local\_cols } +\subsubsection*{get\_local\_cols --- Get number of local cols} +\addcontentsline{toc}{subsubsection}{get\_local\_cols } \begin{verbatim} -nc = psb_cd_get_local_cols(desc) +nc = desc%get_local_cols() \end{verbatim} \begin{description} @@ -506,11 +645,11 @@ Specified as: a structured data of type \descdata. \end{description} -\subsubsection*{psb\_cd\_get\_global\_rows --- Get number of global rows} -\addcontentsline{toc}{subsubsection}{psb\_cd\_get\_global\_rows } +\subsubsection*{get\_global\_rows --- Get number of global rows} +\addcontentsline{toc}{subsubsection}{get\_global\_rows } \begin{verbatim} -nr = psb_cd_get_global_rows(desc) +nr = desc%get_global_rows() \end{verbatim} \begin{description} @@ -528,11 +667,11 @@ Specified as: a structured data of type \descdata. \item[Function value] The number of global rows in the mesh \end{description} -\subsubsection*{psb\_cd\_get\_global\_cols --- Get number of global cols} -\addcontentsline{toc}{subsubsection}{psb\_cd\_get\_global\_cols } +\subsubsection*{get\_global\_cols --- Get number of global cols} +\addcontentsline{toc}{subsubsection}{get\_global\_cols } \begin{verbatim} -nr = psb_cd_get_global_cols(desc) +nr = desc%get_global_cols() \end{verbatim} \begin{description} @@ -551,9 +690,9 @@ Specified as: a structured data of type \descdata. \end{description} -\subsubroutine{psb\_cd\_get\_context}{Get communication context} +\subsubroutine{get\_context}{Get communication context} \begin{verbatim} -ictxt = psb_cd_get_context(desc) +ictxt = desc%get_context() \end{verbatim} \begin{description} @@ -608,12 +747,11 @@ Note: the threshold value is only queried by the library at the time a call to \verb|psb_cdall| is executed, therefore changing the threshold has no effect on communication descriptors that have already been initialized. -\subsubsection*{psb\_sp\_get\_nrows --- Get number of rows in a sparse - matrix} -\addcontentsline{toc}{subsubsection}{ psb\_sp\_get\_nrows} +\subsubsection*{get\_nrows --- Get number of rows in a sparse matrix} +\addcontentsline{toc}{subsubsection}{get\_nrows} \begin{verbatim} -nr = psb_sp_get_nrows(a) +nr = a%get_nrows() \end{verbatim} \begin{description} @@ -632,12 +770,11 @@ Specified as: a structured data of type \spdata. \end{description} -\subsubsection*{psb\_sp\_get\_ncols --- Get number of columns in a - sparse matrix} -\addcontentsline{toc}{subsubsection}{psb\_sp\_get\_ncols} +\subsubsection*{get\_ncols --- Get number of columns in a sparse matrix} +\addcontentsline{toc}{subsubsection}{get\_ncols} \begin{verbatim} -nr = psb_sp_get_ncols(a) +nr = a%get_ncols() \end{verbatim} \begin{description} @@ -656,12 +793,12 @@ Specified as: a structured data of type \spdata. \end{description} -\subsubsection*{psb\_sp\_get\_nnzeros --- Get number of nonzero elements +\subsubsection*{get\_nnzeros --- Get number of nonzero elements in a sparse matrix} -\addcontentsline{toc}{subsubsection}{psb\_sp\_get\_nnzeros} +\addcontentsline{toc}{subsubsection}{get\_nnzeros} \begin{verbatim} -nr = psb_sp_get_nnzeros(a) +nr = a%get_nnzeros() \end{verbatim} \begin{description} diff --git a/krylov/Makefile b/krylov/Makefile index 78b1e054b..fa4eb5532 100644 --- a/krylov/Makefile +++ b/krylov/Makefile @@ -6,7 +6,7 @@ LIBDIR=../lib MODOBJS= psb_base_inner_krylov_mod.o \ psb_s_inner_krylov_mod.o psb_c_inner_krylov_mod.o psb_d_inner_krylov_mod.o psb_z_inner_krylov_mod.o \ - psb_inner_krylov_mod.o psb_krylov_mod.o + psb_krylov_mod.o F90OBJS=psb_dkrylov.o psb_skrylov.o psb_ckrylov.o psb_zkrylov.o \ psb_dcgstab.o psb_dcg.o psb_dcgs.o \ psb_dbicg.o psb_dcgstabl.o psb_drgmres.o\ @@ -24,17 +24,12 @@ LIBNAME=$(METHDLIBNAME) FINCLUDES=$(FMFLAG)$(LIBDIR) $(FMFLAG). -lib: $(LIBDIR)/$(LIBNAME) $(LIBDIR)/$(LIBMOD) - -$(LIBDIR)/$(LIBNAME): $(HERE)/$(LIBNAME) - /bin/cp -p $(CPUPDFLAG) $(HERE)/$(LIBNAME) $(LIBDIR) - -$(LIBDIR)/$(LIBMOD): - /bin/cp -p $(CPUPDFLAG) $(LIBMOD) $(LIBDIR) - -$(HERE)/$(LIBNAME): $(OBJS) +lib: $(OBJS) $(AR) $(HERE)/$(LIBNAME) $(OBJS) $(RANLIB) $(HERE)/$(LIBNAME) + /bin/cp -p $(CPUPDFLAG) $(HERE)/$(LIBNAME) $(LIBDIR) + /bin/cp -p $(CPUPDFLAG) $(LIBMOD) $(LIBDIR) + psb_s_inner_krylov_mod.o psb_c_inner_krylov_mod.o psb_d_inner_krylov_mod.o psb_z_inner_krylov_mod.o: psb_base_inner_krylov_mod.o psb_inner_krylov_mod.o: psb_s_inner_krylov_mod.o psb_c_inner_krylov_mod.o psb_d_inner_krylov_mod.o psb_z_inner_krylov_mod.o diff --git a/krylov/psb_base_inner_krylov_mod.f90 b/krylov/psb_base_inner_krylov_mod.f90 index 75c85e31c..72b5c6bfc 100644 --- a/krylov/psb_base_inner_krylov_mod.f90 +++ b/krylov/psb_base_inner_krylov_mod.f90 @@ -157,5 +157,6 @@ contains call log_end(methdname,me,it,errnum,errden,eps,err,iter) end subroutine psb_d_end_conv + end module psb_base_inner_krylov_mod diff --git a/krylov/psb_c_inner_krylov_mod.f90 b/krylov/psb_c_inner_krylov_mod.f90 index 9cb6fb169..3d79e0393 100644 --- a/krylov/psb_c_inner_krylov_mod.f90 +++ b/krylov/psb_c_inner_krylov_mod.f90 @@ -38,23 +38,24 @@ Module psb_c_inner_krylov_mod use psb_base_inner_krylov_mod interface psb_init_conv - module procedure psb_c_init_conv + module procedure psb_c_init_conv, psb_c_init_conv_vect end interface interface psb_check_conv - module procedure psb_c_check_conv + module procedure psb_c_check_conv, psb_c_check_conv_vect end interface contains + subroutine psb_c_init_conv(methdname,stopc,trace,itmax,a,b,eps,desc_a,stopdat,info) use psb_base_mod implicit none character(len=*), intent(in) :: methdname integer, intent(in) :: stopc, trace, itmax type(psb_cspmat_type), intent(in) :: a - complex(psb_spk_), intent(in) :: b(:) - real(psb_spk_), intent(in) :: eps + complex(psb_spk_), intent(in) :: b(:) + real(psb_spk_), intent(in) :: eps type(psb_desc_type), intent(in) :: desc_a type(psb_itconv_type) :: stopdat integer, intent(out) :: info @@ -81,7 +82,8 @@ contains select case(stopdat%controls(psb_ik_stopc_)) case (1) stopdat%values(psb_ik_ani_) = psb_spnrmi(a,desc_a,info) - if (info == psb_success_) stopdat%values(psb_ik_bni_) = psb_geamax(b,desc_a,info) + if (info == psb_success_)& + & stopdat%values(psb_ik_bni_) = psb_geamax(b,desc_a,info) case (2) stopdat%values(psb_ik_bn2_) = psb_genrm2(b,desc_a,info) @@ -143,8 +145,9 @@ contains stopdat%values(psb_ik_rni_) = psb_geamax(r,desc_a,info) if (info == psb_success_) stopdat%values(psb_ik_xni_) = psb_geamax(x,desc_a,info) stopdat%values(psb_ik_errnum_) = stopdat%values(psb_ik_rni_) - stopdat%values(psb_ik_errden_) = & - & (stopdat%values(psb_ik_ani_)*stopdat%values(psb_ik_xni_)+stopdat%values(psb_ik_bni_)) + stopdat%values(psb_ik_errden_) =& + & (stopdat%values(psb_ik_ani_)*stopdat%values(psb_ik_xni_)& + & +stopdat%values(psb_ik_bni_)) case(2) stopdat%values(psb_ik_rn2_) = psb_genrm2(r,desc_a,info) stopdat%values(psb_ik_errnum_) = stopdat%values(psb_ik_rn2_) @@ -162,10 +165,11 @@ contains end if if (stopdat%values(psb_ik_errden_) == dzero) then - psb_c_check_conv = (stopdat%values(psb_ik_errnum_) <= stopdat%values(psb_ik_eps_)) + psb_c_check_conv = (stopdat%values(psb_ik_errnum_) <=& + & stopdat%values(psb_ik_eps_)) else - psb_c_check_conv = & - & (stopdat%values(psb_ik_errnum_) <= stopdat%values(psb_ik_eps_)*stopdat%values(psb_ik_errden_)) + psb_c_check_conv = (stopdat%values(psb_ik_errnum_) <=& + & stopdat%values(psb_ik_eps_)*stopdat%values(psb_ik_errden_)) end if psb_c_check_conv = (psb_c_check_conv.or.(stopdat%controls(psb_ik_itmax_) <= it)) @@ -188,4 +192,150 @@ contains end function psb_c_check_conv + + subroutine psb_c_init_conv_vect(methdname,stopc,trace,itmax,a,b,eps,desc_a,stopdat,info) + use psb_base_mod + implicit none + character(len=*), intent(in) :: methdname + integer, intent(in) :: stopc, trace,itmax + type(psb_cspmat_type), intent(in) :: a + real(psb_spk_), intent(in) :: eps + type(psb_c_vect_type), intent(inout) :: b + type(psb_desc_type), intent(in) :: desc_a + type(psb_itconv_type) :: stopdat + integer, intent(out) :: info + + integer :: ictxt, me, np, err_act + character(len=20) :: name + + info = psb_success_ + name = 'psb_init_conv' + call psb_erractionsave(err_act) + + + ictxt=desc_a%get_context() + + call psb_info(ictxt, me, np) + + stopdat%controls(:) = 0 + stopdat%values(:) = szero + + stopdat%controls(psb_ik_stopc_) = stopc + stopdat%controls(psb_ik_trace_) = trace + stopdat%controls(psb_ik_itmax_) = itmax + + select case(stopdat%controls(psb_ik_stopc_)) + case (1) + stopdat%values(psb_ik_ani_) = psb_spnrmi(a,desc_a,info) + if (info == psb_success_)& + & stopdat%values(psb_ik_bni_) = psb_geamax(b,desc_a,info) + + case (2) + stopdat%values(psb_ik_bn2_) = psb_genrm2(b,desc_a,info) + + case default + info=psb_err_invalid_istop_ + call psb_errpush(info,name,i_err=(/stopc,0,0,0,0/)) + goto 9999 + end select + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,a_err="Init conv check data") + goto 9999 + end if + + stopdat%values(psb_ik_eps_) = eps + stopdat%values(psb_ik_errnum_) = szero + stopdat%values(psb_ik_errden_) = done + + if ((stopdat%controls(psb_ik_trace_) > 0).and. (me == 0))& + & call log_header(methdname) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + + end subroutine psb_c_init_conv_vect + + function psb_c_check_conv_vect(methdname,it,x,r,desc_a,stopdat,info) result(res) + use psb_base_mod + implicit none + character(len=*), intent(in) :: methdname + integer, intent(in) :: it + type(psb_c_vect_type), intent(inout) :: x, r + type(psb_desc_type), intent(in) :: desc_a + type(psb_itconv_type) :: stopdat + logical :: res + integer, intent(out) :: info + + integer :: ictxt, me, np, err_act + character(len=20) :: name + + info = psb_success_ + res = .false. + if (psb_errstatus_fatal()) return + name = 'psb_check_conv' + call psb_erractionsave(err_act) + + ictxt = desc_a%get_context() + call psb_info(ictxt,me,np) + + + + select case(stopdat%controls(psb_ik_stopc_)) + case(1) + stopdat%values(psb_ik_rni_) = psb_geamax(r,desc_a,info) + if (info == psb_success_) stopdat%values(psb_ik_xni_) = psb_geamax(x,desc_a,info) + stopdat%values(psb_ik_errnum_) = stopdat%values(psb_ik_rni_) + stopdat%values(psb_ik_errden_) = & + & (stopdat%values(psb_ik_ani_)*stopdat%values(psb_ik_xni_)& + & +stopdat%values(psb_ik_bni_)) + case(2) + stopdat%values(psb_ik_rn2_) = psb_genrm2(r,desc_a,info) + stopdat%values(psb_ik_errnum_) = stopdat%values(psb_ik_rn2_) + stopdat%values(psb_ik_errden_) = stopdat%values(psb_ik_bn2_) + + case default + info=psb_err_internal_error_ + call psb_errpush(info,name,a_err="Control data in stopdat messed up!") + goto 9999 + end select + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + if (stopdat%values(psb_ik_errden_) == dzero) then + res = (stopdat%values(psb_ik_errnum_) <= stopdat%values(psb_ik_eps_)) + else + res = (stopdat%values(psb_ik_errnum_) <=& + & stopdat%values(psb_ik_eps_)*stopdat%values(psb_ik_errden_)) + end if + + res = (res.or.(stopdat%controls(psb_ik_itmax_) <= it)) + + if ( (stopdat%controls(psb_ik_trace_) > 0).and.& + & ((mod(it,stopdat%controls(psb_ik_trace_)) == 0).or.res)) then + call log_conv(methdname,me,it,1,stopdat%values(psb_ik_errnum_),& + & stopdat%values(psb_ik_errden_),stopdat%values(psb_ik_eps_)) + 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(ictxt) + return + end if + + end function psb_c_check_conv_vect + end module psb_c_inner_krylov_mod diff --git a/krylov/psb_cbicg.f90 b/krylov/psb_cbicg.f90 index ccdd78c15..d6fc06eed 100644 --- a/krylov/psb_cbicg.f90 +++ b/krylov/psb_cbicg.f90 @@ -96,7 +96,7 @@ subroutine psb_cbicg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) use psb_base_mod use psb_prec_mod - use psb_inner_krylov_mod + use psb_c_inner_krylov_mod use psb_krylov_mod implicit none @@ -335,3 +335,252 @@ subroutine psb_cbicg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) end subroutine psb_cbicg + +subroutine psb_cbicg_vect(a,prec,b,x,eps,desc_a,info,& + & itmax,iter,err,itrace,istop) + use psb_base_mod + use psb_prec_mod + use psb_c_inner_krylov_mod + use psb_krylov_mod + implicit none + type(psb_cspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + class(psb_cprec_type), intent(inout) :: prec + type(psb_c_vect_type), Intent(inout) :: b + type(psb_c_vect_type), Intent(inout) :: x + real(psb_spk_), intent(in) :: eps + integer, intent(out) :: info + integer, optional, intent(in) :: itmax, itrace, istop + integer, optional, intent(out) :: iter + real(psb_spk_), optional, intent(out) :: err +!!$ local data + complex(psb_spk_), allocatable, target :: aux(:) + type(psb_c_vect_type), allocatable, target :: wwrk(:) + type(psb_c_vect_type), pointer :: ww, q, r, p,& + & zt, pt, z, rt, qt + integer :: int_err(5) + integer :: itmax_, naux, mglob, it, itrace_,& + & np,me, n_row, n_col, istop_, err_act + integer :: debug_level, debug_unit + logical, parameter :: exchange=.true., noexchange=.false. + integer, parameter :: irmax = 8 + integer :: itx, isvch, ictxt + complex(psb_spk_) :: alpha, beta, rho, rho_old, sigma + real(psb_dpk_) :: derr + type(psb_itconv_type) :: stopdat + character(len=20) :: name,ch_err + character(len=*), parameter :: methdname='BiCG' + + info = psb_success_ + name = 'psb_bicg' + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt = desc_a%get_context() + call psb_info(ictxt, me, np) + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),': from psb_info',np + + mglob = desc_a%get_global_rows() + n_row = desc_a%get_local_rows() + n_col = desc_a%get_local_cols() + + ! Ensure global coherence for convergence checks. + call psb_set_coher(ictxt,isvch) + + if (.not.allocated(b%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + if (present(istop)) then + istop_ = istop + else + istop_ = 2 + endif + ! + ! istop_ = 1: normwise backward error, infinity norm + ! istop_ = 2: ||r||/||b|| norm 2 + ! + + if ((istop_ < 1 ).or.(istop_ > 2 ) ) then + info=psb_err_invalid_istop_ + int_err=istop_ + err=info + call psb_errpush(info,name,i_err=int_err) + goto 9999 + endif + + call psb_chkvect(mglob,1,x%get_nrows(),1,1,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_chkvect on X') + goto 9999 + end if + call psb_chkvect(mglob,1,b%get_nrows(),1,1,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_chkvect on B') + goto 9999 + end if + + + naux=4*n_col + + allocate(aux(naux),stat=info) + if (info == psb_success_) call psb_geall(wwrk,desc_a,info,n=9) + if (info == psb_success_) call psb_geasb(wwrk,desc_a,info,mold=x%v) + if(info /= psb_success_) then + info=psb_err_from_subroutine_non_ + ch_err='psb_asb' + err=info + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + q => wwrk(1) + qt => wwrk(2) + r => wwrk(3) + rt => wwrk(4) + p => wwrk(5) + pt => wwrk(6) + z => wwrk(7) + zt => wwrk(8) + ww => wwrk(9) + + if (present(itmax)) then + itmax_ = itmax + else + itmax_ = 1000 + endif + + if (present(itrace)) then + itrace_ = itrace + else + itrace_ = 0 + end if + + itx = 0 + + + call psb_init_conv(methdname,istop_,itrace_,itmax_,a,b,eps,desc_a,stopdat,info) + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + restart: do +!!$ +!!$ r0 = b-ax0 +!!$ + if (itx >= itmax_) exit restart + it = 0 + call psb_geaxpby(cone,b,czero,r,desc_a,info) + if (info == psb_success_) call psb_spmm(-cone,a,x,cone,r,desc_a,info,work=aux) + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),' Done spmm',info + if (info == psb_success_) call psb_geaxpby(cone,r,czero,rt,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + rho = czero + + ! Perhaps we already satisfy the convergence criterion... + if (psb_check_conv(methdname,itx,x,r,desc_a,stopdat,info)) exit restart + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + iteration: do + it = it + 1 + itx = itx + 1 + + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),'iteration: ',itx + + call prec%apply(r,z,desc_a,info,work=aux) + if (info == psb_success_) call prec%apply(rt,zt,desc_a,info,trans='c',work=aux) + + rho_old = rho + rho = psb_gedot(rt,z,desc_a,info) + if (rho == czero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' iteration breakdown r',rho + exit iteration + endif + + if (it == 1) then + call psb_geaxpby(cone,z,czero,p,desc_a,info) + call psb_geaxpby(cone,zt,czero,pt,desc_a,info) + else + beta = (rho/rho_old) + call psb_geaxpby(cone,z,beta,p,desc_a,info) + call psb_geaxpby(cone,zt,beta,pt,desc_a,info) + end if + + call psb_spmm(cone,a,p,czero,q,desc_a,info,& + & work=aux) + call psb_spmm(cone,a,pt,czero,qt,desc_a,info,& + & work=aux,trans='c') + + sigma = psb_gedot(pt,q,desc_a,info) + if (sigma == czero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' iteration breakdown s1', sigma + exit iteration + endif + + alpha = rho/sigma + + + call psb_geaxpby(alpha,p,cone,x,desc_a,info) + call psb_geaxpby(-alpha,q,cone,r,desc_a,info) + call psb_geaxpby(-alpha,qt,cone,rt,desc_a,info) + + if (psb_check_conv(methdname,itx,x,r,desc_a,stopdat,info)) exit restart + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + end do iteration + end do restart + + call psb_end_conv(methdname,itx,desc_a,stopdat,info,derr,iter) + if (present(err)) err = derr + + if (info == psb_success_) call psb_gefree(wwrk,desc_a,info) + if (info == psb_success_) deallocate(aux,stat=info) + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + ! restore external global coherence behaviour + call psb_restore_coher(ictxt,isvch) + + 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 psb_cbicg_vect + diff --git a/krylov/psb_ccg.f90 b/krylov/psb_ccg.f90 index 877c074f2..8b0790f2b 100644 --- a/krylov/psb_ccg.f90 +++ b/krylov/psb_ccg.f90 @@ -98,7 +98,7 @@ subroutine psb_ccg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) use psb_base_mod use psb_prec_mod - use psb_inner_krylov_mod + use psb_c_inner_krylov_mod use psb_krylov_mod implicit none @@ -284,3 +284,203 @@ subroutine psb_ccg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) end subroutine psb_ccg +subroutine psb_ccg_vect(a,prec,b,x,eps,desc_a,info,& + & itmax,iter,err,itrace,istop) + use psb_base_mod + use psb_prec_mod + use psb_c_inner_krylov_mod + use psb_krylov_mod + implicit none + type(psb_cspmat_type), intent(in) :: a + Type(psb_desc_type), Intent(in) :: desc_a + class(psb_cprec_type), intent(inout) :: prec + type(psb_c_vect_type), Intent(inout) :: b + type(psb_c_vect_type), Intent(inout) :: x + Real(psb_spk_), Intent(in) :: eps + integer, intent(out) :: info + Integer, Optional, Intent(in) :: itmax, itrace, istop + Integer, Optional, Intent(out) :: iter + Real(psb_spk_), Optional, Intent(out) :: err +!!$ Local data + complex(psb_spk_), allocatable, target :: aux(:) + type(psb_c_vect_type), allocatable, target :: wwrk(:) + type(psb_c_vect_type), pointer :: q, p, r, z, w + complex(psb_spk_) :: alpha, beta, rho, rho_old, sigma,alpha_old,beta_old + integer :: itmax_, istop_, naux, mglob, it, itx, itrace_,& + & np,me, n_col, isvch, ictxt, n_row,err_act, int_err(5), ieg,nspl, istebz + integer :: debug_level, debug_unit + real(psb_dpk_) :: derr + type(psb_itconv_type) :: stopdat + character(len=20) :: name + character(len=*), parameter :: methdname='CG' + + info = psb_success_ + name = 'psb_ccg' + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt = desc_a%get_context() + + call psb_info(ictxt, me, np) + if (.not.allocated(b%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + mglob = desc_a%get_global_rows() + n_row = desc_a%get_local_rows() + n_col = desc_a%get_local_cols() + + + if (present(istop)) then + istop_ = istop + else + istop_ = 2 + endif + + call psb_chkvect(mglob,1,x%get_nrows(),1,1,desc_a,info) + if (info == psb_success_)& + & call psb_chkvect(mglob,1,b%get_nrows(),1,1,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_chkvect on X/B') + goto 9999 + end if + + naux=4*n_col + allocate(aux(naux), stat=info) + if (info == psb_success_) call psb_geall(wwrk,desc_a,info,n=5) + if (info == psb_success_) call psb_geasb(wwrk,desc_a,info,mold=x%v) + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + p => wwrk(1) + q => wwrk(2) + r => wwrk(3) + z => wwrk(4) + w => wwrk(5) + + + if (present(itmax)) then + itmax_ = itmax + else + itmax_ = 1000 + endif + + if (present(itrace)) then + itrace_ = itrace + else + itrace_ = 0 + end if + + + itx=0 + + ! Ensure global coherence for convergence checks. + call psb_set_coher(ictxt,isvch) + + restart: do +!!$ +!!$ r0 = b-Ax0 +!!$ + if (itx>= itmax_) exit restart + + it = 0 + call psb_geaxpby(cone,b,czero,r,desc_a,info) + if (info == psb_success_) call psb_spmm(-cone,a,x,cone,r,desc_a,info,work=aux) + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + rho = czero + + call psb_init_conv(methdname,istop_,itrace_,itmax_,a,b,eps,desc_a,stopdat,info) + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + iteration: do + + it = it + 1 + itx = itx + 1 + + call prec%apply(r,z,desc_a,info,work=aux) + rho_old = rho + rho = psb_gedot(r,z,desc_a,info) + + if (it == 1) then + call psb_geaxpby(cone,z,czero,p,desc_a,info) + else + if (rho_old == czero) then + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),& + & ': CG Iteration breakdown rho' + exit iteration + endif + beta = rho/rho_old + call psb_geaxpby(cone,z,beta,p,desc_a,info) + end if + + call psb_spmm(cone,a,p,czero,q,desc_a,info,work=aux) + sigma = psb_gedot(p,q,desc_a,info) + if (sigma == czero) then + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),& + & ': CG Iteration breakdown sigma' + exit iteration + endif + alpha_old = alpha + alpha = rho/sigma + + call psb_geaxpby(alpha,p,cone,x,desc_a,info) + call psb_geaxpby(-alpha,q,cone,r,desc_a,info) + + if (psb_check_conv(methdname,itx,x,r,desc_a,stopdat,info)) exit restart + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + end do iteration + end do restart + + call psb_end_conv(methdname,itx,desc_a,stopdat,info,derr,iter) + if (present(err)) err = derr + + if (info == psb_success_) call psb_gefree(wwrk,desc_a,info) + if (info == psb_success_) deallocate(aux,stat=info) + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + + ! restore external global coherence behaviour + call psb_restore_coher(ictxt,isvch) + + 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 psb_ccg_vect + diff --git a/krylov/psb_ccgs.f90 b/krylov/psb_ccgs.f90 index 049c0a0ba..dc53e8293 100644 --- a/krylov/psb_ccgs.f90 +++ b/krylov/psb_ccgs.f90 @@ -95,7 +95,7 @@ Subroutine psb_ccgs(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) use psb_base_mod use psb_prec_mod - use psb_inner_krylov_mod + use psb_c_inner_krylov_mod use psb_krylov_mod implicit none @@ -327,3 +327,245 @@ Subroutine psb_ccgs(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) return end subroutine psb_ccgs + +Subroutine psb_ccgs_vect(a,prec,b,x,eps,desc_a,info,& + & itmax,iter,err,itrace,istop) + use psb_base_mod + use psb_prec_mod + use psb_c_inner_krylov_mod + use psb_krylov_mod + implicit none + type(psb_cspmat_type), intent(in) :: a + Type(psb_desc_type), Intent(in) :: desc_a + class(psb_cprec_type), intent(inout) :: prec + type(psb_c_vect_type), Intent(inout) :: b + type(psb_c_vect_type), Intent(inout) :: x + Real(psb_spk_), Intent(in) :: eps + integer, intent(out) :: info + Integer, Optional, Intent(in) :: itmax, itrace,istop + Integer, Optional, Intent(out) :: iter + Real(psb_spk_), Optional, Intent(out) :: err +!!$ local data + complex(psb_spk_), allocatable, target :: aux(:) + type(psb_c_vect_type), allocatable, target :: wwrk(:) + type(psb_c_vect_type), pointer :: ww, q, r, p, v,& + & s, z, f, rt, qt, uv + Integer :: itmax_, naux, mglob, it, itrace_,int_err(5),& + & np,me, n_row, n_col,istop_, err_act + Integer :: itx, isvch, ictxt + integer :: debug_level, debug_unit + complex(psb_spk_) :: alpha, beta, rho, rho_old, sigma + real(psb_dpk_) :: derr + type(psb_itconv_type) :: stopdat + character(len=20) :: name + character(len=*), parameter :: methdname='CGS' + + info = psb_success_ + name = 'psb_ccgs' + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt = desc_a%get_context() + Call psb_info(ictxt, me, np) + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),': from psb_info',np + if (.not.allocated(b%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + mglob = desc_a%get_global_rows() + n_row = desc_a%get_local_rows() + n_col = desc_a%get_local_cols() + + If (Present(istop)) Then + istop_ = istop + Else + istop_ = 2 + Endif + + call psb_chkvect(mglob,1,x%get_nrows(),1,1,desc_a,info) + if (info == psb_success_) call psb_chkvect(mglob,1,b%get_nrows(),1,1,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_chkvect on X/B') + goto 9999 + end if + + naux=4*n_col + Allocate(aux(naux),stat=info) + if (info == psb_success_) Call psb_geall(wwrk,desc_a,info,n=11) + if (info == psb_success_) Call psb_geasb(wwrk,desc_a,info,mold=x%v) + if (info /= psb_success_) Then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + End If + + q => wwrk(1) + qt => wwrk(2) + r => wwrk(3) + rt => wwrk(4) + p => wwrk(5) + v => wwrk(6) + uv => wwrk(7) + z => wwrk(8) + f => wwrk(9) + s => wwrk(10) + ww => wwrk(11) + + + If (Present(itmax)) Then + itmax_ = itmax + Else + itmax_ = 1000 + Endif + + If (Present(itrace)) Then + itrace_ = itrace + Else + itrace_ = 0 + End If + + ! Ensure global coherence for convergence checks. + call psb_set_coher(ictxt,isvch) + + itx = 0 + + call psb_init_conv(methdname,istop_,itrace_,itmax_,a,b,eps,desc_a,stopdat,info) + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + restart: Do +!!$ +!!$ r0 = b-ax0 +!!$ + if (itx >= itmax_) exit restart + it = 0 + call psb_geaxpby(cone,b,czero,r,desc_a,info) + if (info == psb_success_) call psb_spmm(-cone,a,x,cone,r,desc_a,info,work=aux) + if (info == psb_success_) call psb_geaxpby(cone,r,czero,rt,desc_a,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + + ! Perhaps we already satisfy the convergence criterion... + if (psb_check_conv(methdname,itx,x,r,desc_a,stopdat,info)) exit restart + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + rho = czero + + iteration: do + it = it + 1 + itx = itx + 1 + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),'iteration: ',itx + + rho_old = rho + rho = psb_gedot(rt,r,desc_a,info) + + if (rho == czero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' iteration breakdown r',rho + exit iteration + endif + + if (it == 1) then + call psb_geaxpby(cone,r,czero,uv,desc_a,info) + if (info == psb_success_) call psb_geaxpby(cone,r,czero,p,desc_a,info) + else + beta = (rho/rho_old) + call psb_geaxpby(cone,r,czero,uv,desc_a,info) + if (info == psb_success_) call psb_geaxpby(beta,q,cone,uv,desc_a,info) + if (info == psb_success_) call psb_geaxpby(cone,q,beta,p,desc_a,info) + if (info == psb_success_) call psb_geaxpby(cone,uv,beta,p,desc_a,info) + end if + + if (info == psb_success_) call prec%apply(p,f,desc_a,info,work=aux) + + if (info == psb_success_) call psb_spmm(cone,a,f,czero,v,desc_a,info,& + & work=aux) + + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='First loop part ') + goto 9999 + end if + + sigma = psb_gedot(rt,v,desc_a,info) + if (sigma == czero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' iteration breakdown s1', sigma + exit iteration + endif + + alpha = rho/sigma + + if (info == psb_success_) call psb_geaxpby(cone,uv,czero,q,desc_a,info) + if (info == psb_success_) call psb_geaxpby(-alpha,v,cone,q,desc_a,info) + if (info == psb_success_) call psb_geaxpby(cone,uv,czero,s,desc_a,info) + if (info == psb_success_) call psb_geaxpby(cone,q,cone,s,desc_a,info) + + if (info == psb_success_) call prec%apply(s,z,desc_a,info,work=aux) + + if (info == psb_success_) call psb_geaxpby(alpha,z,cone,x,desc_a,info) + + if (info == psb_success_) call psb_spmm(cone,a,z,czero,qt,desc_a,info,& + & work=aux) + + if (info == psb_success_) call psb_geaxpby(-alpha,qt,cone,r,desc_a,info) + + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='X update ') + goto 9999 + end if + + if (psb_check_conv(methdname,itx,x,r,desc_a,stopdat,info)) exit restart + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + end do iteration + end do restart + + call psb_end_conv(methdname,itx,desc_a,stopdat,info,derr,iter) + if (present(err)) err = derr + + if (info == psb_success_) call psb_gefree(wwrk,desc_a,info) + if (info == psb_success_) deallocate(aux,stat=info) + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + + ! restore external global coherence behaviour + call psb_restore_coher(ictxt,isvch) + 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 psb_ccgs_vect diff --git a/krylov/psb_ccgstab.f90 b/krylov/psb_ccgstab.f90 index 9cbdfe1fc..47da73baa 100644 --- a/krylov/psb_ccgstab.f90 +++ b/krylov/psb_ccgstab.f90 @@ -96,7 +96,7 @@ subroutine psb_ccgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) use psb_base_mod use psb_prec_mod - use psb_inner_krylov_mod + use psb_c_inner_krylov_mod use psb_krylov_mod Implicit None !!$ parameters @@ -356,3 +356,318 @@ subroutine psb_ccgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) End Subroutine psb_ccgstab + +Subroutine psb_ccgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) + use psb_base_mod + use psb_prec_mod + use psb_c_inner_krylov_mod + use psb_krylov_mod + implicit none + type(psb_cspmat_type), intent(in) :: a + class(psb_cprec_type), Intent(inout) :: prec + Type(psb_desc_type), Intent(in) :: desc_a + type(psb_c_vect_type), Intent(inout) :: b + type(psb_c_vect_type), Intent(inout) :: x + Real(psb_spk_), Intent(in) :: eps + integer, intent(out) :: info + Integer, Optional, Intent(in) :: itmax, itrace, istop + Integer, Optional, Intent(out) :: iter + Real(psb_spk_), Optional, Intent(out) :: err +!!$ Local data + complex(psb_spk_), allocatable, target :: aux(:),wwrk(:,:) + type(psb_c_vect_type) :: q, r, p, v, s, t, z, f + + Integer :: itmax_, naux, mglob, it,itrace_,& + & np,me, n_row, n_col + integer :: debug_level, debug_unit + Logical, Parameter :: exchange=.True., noexchange=.False., debug1 = .False. + Integer, Parameter :: irmax = 8 + Integer :: itx, isvch, ictxt, err_act, i + Integer :: istop_ + real(psb_dpk_) :: derr + complex(psb_spk_) :: alpha, beta, rho, rho_old, sigma, omega, tau + type(psb_itconv_type) :: stopdat + + character(len=20) :: name + character(len=*), parameter :: methdname='BiCGStab' + + info = psb_success_ + name = 'psb_scgstab' + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + ictxt = desc_a%get_context() + call psb_info(ictxt, me, np) + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),': from psb_info',np + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(b%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + mglob = desc_a%get_global_rows() + n_row = desc_a%get_local_rows() + n_col = desc_a%get_local_cols() + + If (Present(istop)) Then + istop_ = istop + Else + istop_ = 2 + Endif + ! + ! ISTOP_ = 1: Normwise backward error, infinity norm + ! ISTOP_ = 2: ||r||/||b|| norm 2 + ! +!!$ if (.not.same_type_as(x,b)) then +!!$ write(0,*) 'Warning: different dynamic types for X and B ' +!!$ end if + + call psb_chkvect(mglob,1,x%get_nrows(),1,1,desc_a,info) + if (psb_errstatus_fatal()) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_chkvect on X') + goto 9999 + end if + call psb_chkvect(mglob,1,b%get_nrows(),1,1,desc_a,info) + if (psb_errstatus_fatal()) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_chkvect on B') + goto 9999 + end if + naux=6*n_col + if (info == psb_success_) allocate(aux(naux),stat=info) + if (info /= psb_success_) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + End If + + + call psb_geall(q,desc_a,info) + call psb_geall(r,desc_a,info) + call psb_geall(p,desc_a,info) + call psb_geall(v,desc_a,info) + call psb_geall(s,desc_a,info) + call psb_geall(t,desc_a,info) + call psb_geall(z,desc_a,info) + call psb_geall(f,desc_a,info) + + call psb_geasb(q,desc_a,info,mold=x%v) + call psb_geasb(r,desc_a,info,mold=x%v) + call psb_geasb(p,desc_a,info,mold=x%v) + call psb_geasb(v,desc_a,info,mold=x%v) + call psb_geasb(s,desc_a,info,mold=x%v) + call psb_geasb(t,desc_a,info,mold=x%v) + call psb_geasb(z,desc_a,info,mold=x%v) + call psb_geasb(f,desc_a,info,mold=x%v) + + + if (psb_errstatus_fatal()) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + End If + + If (Present(itmax)) Then + itmax_ = itmax + Else + itmax_ = 1000 + Endif + + If (Present(itrace)) Then + itrace_ = itrace + Else + itrace_ = 0 + End If + + ! Ensure global coherence for convergence checks. + call psb_set_coher(ictxt,isvch) + + itx = 0 + call psb_init_conv(methdname,istop_,itrace_,itmax_,a,b,eps,desc_a,stopdat,info) + if (psb_errstatus_fatal()) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + restart: Do + + if (itx >= itmax_) exit restart + + it = 0 + call psb_geaxpby(cone,b,czero,r,desc_a,info) + + call psb_spmm(-cone,a,x,cone,r,desc_a,info,work=aux) + call psb_geaxpby(cone,r,czero,q,desc_a,info) + + ! Perhaps we already satisfy the convergence criterion... + if (psb_check_conv(methdname,itx,x,r,desc_a,stopdat,info)) exit restart + + if (psb_errstatus_fatal()) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='Init residual chk') + goto 9999 + end if + + + rho = czero + + iteration: Do + it = it + 1 + itx = itx + 1 + + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),& + & ' Iteration: ',itx + + rho_old = rho + rho = psb_gedot(q,r,desc_a,info) + + if (debug_level >= psb_debug_ext_) then + call q%sync() + call r%sync() + end if + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),& + & ' Rho: ',rho + + if (rho == czero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' Iteration breakdown R',rho + exit iteration + endif + + if (it == 1) then + call psb_geaxpby(cone,r,czero,p,desc_a,info) + else + beta = (rho/rho_old)*(alpha/omega) + call psb_geaxpby(-omega,v,cone,p,desc_a,info) + call psb_geaxpby(cone,r,beta,p,desc_a,info) + End If + + call prec%apply(p,f,desc_a,info,work=aux) + + call psb_spmm(cone,a,f,czero,v,desc_a,info,& + & work=aux) + + + sigma = psb_gedot(q,v,desc_a,info) + + if (debug_level >= psb_debug_ext_) then + call q%sync() + call v%sync() + end if + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),& + & ' Sigma: ',sigma + + if (sigma == czero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' Iteration breakdown S1', sigma + exit iteration + endif + + alpha = rho/sigma + call psb_geaxpby(cone,r,czero,s,desc_a,info) + call psb_geaxpby(-alpha,v,cone,s,desc_a,info) + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),& + & ' alpha: ',alpha + + + if (psb_errstatus_fatal()) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_geaxpby') + goto 9999 + end if + + + call prec%apply(s,z,desc_a,info,work=aux) + Call psb_spmm(cone,a,z,czero,t,desc_a,info,work=aux) + + if(psb_errstatus_fatal()) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='precaply/spmm') + goto 9999 + end if + + sigma = psb_gedot(t,t,desc_a,info) + if (sigma == czero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' Iteration breakdown S2', sigma + exit iteration + endif + + tau = psb_gedot(t,s,desc_a,info) + omega = tau/sigma + + if (debug_level >= psb_debug_ext_) then + call t%sync() + call s%sync() + end if + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),& + & ' sigma, tau, omega: ',sigma, tau, omega + + if (omega == czero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' Iteration breakdown O',omega + exit iteration + endif + + call psb_geaxpby(alpha,f,cone,x,desc_a,info) + call psb_geaxpby(omega,z,cone,x,desc_a,info) + call psb_geaxpby(cone,s,czero,r,desc_a,info) + call psb_geaxpby(-omega,t,cone,r,desc_a,info) + if (psb_check_conv(methdname,itx,x,r,desc_a,stopdat,info)) exit restart + + if (psb_errstatus_fatal()) Then + call psb_errpush(psb_err_from_subroutine_,name,a_err='X/R update ') + goto 9999 + End If + + end do iteration + end do restart + + call psb_end_conv(methdname,itx,desc_a,stopdat,info,derr,iter) + if (present(err)) err = derr + + deallocate(aux,stat=info) + + call x%sync() + call psb_gefree(q,desc_a,info) + call psb_gefree(r,desc_a,info) + call psb_gefree(p,desc_a,info) + call psb_gefree(v,desc_a,info) + call psb_gefree(s,desc_a,info) + call psb_gefree(t,desc_a,info) + call psb_gefree(z,desc_a,info) + call psb_gefree(f,desc_a,info) + + if(psb_errstatus_fatal()) then + call psb_errpush(info,name) + goto 9999 + end if + ! restore external global coherence behaviour + call psb_restore_coher(ictxt,isvch) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +End Subroutine psb_ccgstab_vect diff --git a/krylov/psb_ccgstabl.f90 b/krylov/psb_ccgstabl.f90 index d85344b91..45d84ac87 100644 --- a/krylov/psb_ccgstabl.f90 +++ b/krylov/psb_ccgstabl.f90 @@ -106,7 +106,7 @@ Subroutine psb_ccgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,istop) use psb_base_mod use psb_prec_mod - use psb_inner_krylov_mod + use psb_c_inner_krylov_mod use psb_krylov_mod implicit none @@ -412,3 +412,328 @@ Subroutine psb_ccgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,is End Subroutine psb_ccgstabl + +Subroutine psb_ccgstabl_vect(a,prec,b,x,eps,desc_a,info,& + & itmax,iter,err,itrace,irst,istop) + use psb_base_mod + use psb_prec_mod + use psb_c_inner_krylov_mod + use psb_krylov_mod + implicit none + type(psb_cspmat_type), intent(in) :: a + class(psb_cprec_type), Intent(inout) :: prec + Type(psb_desc_type), Intent(in) :: desc_a + type(psb_c_vect_type), Intent(inout) :: b + type(psb_c_vect_type), Intent(inout) :: x + Real(psb_spk_), Intent(in) :: eps + integer, intent(out) :: info + Integer, Optional, Intent(in) :: itmax, itrace, irst,istop + Integer, Optional, Intent(out) :: iter + Real(psb_spk_), Optional, Intent(out) :: err +!!$ local data + complex(psb_spk_), allocatable, target :: aux(:), gamma(:),& + & gamma1(:), gamma2(:), taum(:,:), sigma(:) + type(psb_c_vect_type), allocatable, target :: wwrk(:),uh(:), rh(:) + type(psb_c_vect_type), Pointer :: ww, q, r, rt0, p, v, & + & s, t, z, f + + Integer :: itmax_, naux, mglob, it, itrace_,& + & np,me, n_row, n_col, nl, err_act + Logical, Parameter :: exchange=.True., noexchange=.False. + Integer, Parameter :: irmax = 8 + Integer :: itx, i, isvch, ictxt,istop_,j, k, int_err(5) + integer :: debug_level, debug_unit + complex(psb_spk_) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,& + & omega + real(psb_dpk_) :: derr + type(psb_itconv_type) :: stopdat + character(len=20) :: name + character(len=*), parameter :: methdname='BiCGStab(L)' + + info = psb_success_ + name = 'psb_ccgstabl' + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt = desc_a%get_context() + Call psb_info(ictxt, me, np) + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),': from psb_info',np + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(b%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + mglob = desc_a%get_global_rows() + n_row = desc_a%get_local_rows() + n_col = desc_a%get_local_cols() + + if (present(istop)) then + istop_ = istop + else + istop_ = 2 + endif + + if (present(itmax)) then + itmax_ = itmax + else + itmax_ = 1000 + endif + + if (present(itrace)) then + itrace_ = itrace + else + itrace_ = 0 + end if + + if (present(irst)) then + nl = irst + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & 'present: irst: ',irst,nl + else + nl = 1 + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' not present: irst: ',irst,nl + endif + if (nl <=0 ) then + info=psb_err_invalid_istop_ + int_err(1)=nl + err=info + call psb_errpush(info,name,i_err=int_err) + goto 9999 + endif + + call psb_chkvect(mglob,1,x%get_nrows(),1,1,desc_a,info) + if (info == psb_success_) call psb_chkvect(mglob,1,b%get_nrows(),1,1,desc_a,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_chkvect on X/B') + goto 9999 + end if + + naux=4*n_col + allocate(aux(naux),gamma(0:nl),gamma1(nl),& + &gamma2(nl),taum(nl,nl),sigma(nl), stat=info) + + if (info /= psb_success_) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + end if + if (info == psb_success_) Call psb_geall(wwrk,desc_a,info,n=10) + if (info == psb_success_) Call psb_geall(uh,desc_a,info,n=nl+1,lb=0) + if (info == psb_success_) Call psb_geall(rh,desc_a,info,n=nl+1,lb=0) + if (info == psb_success_) Call psb_geasb(wwrk,desc_a,info,mold=x%v) + if (info == psb_success_) Call psb_geasb(uh,desc_a,info,mold=x%v) + if (info == psb_success_) Call psb_geasb(rh,desc_a,info,mold=x%v) + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + q => wwrk(1) + r => wwrk(2) + p => wwrk(3) + v => wwrk(4) + f => wwrk(5) + s => wwrk(6) + t => wwrk(7) + z => wwrk(8) + ww => wwrk(9) + rt0 => wwrk(10) + + ! Ensure global coherence for convergence checks. + call psb_set_coher(ictxt,isvch) + + + call psb_init_conv(methdname,istop_,itrace_,itmax_,a,b,eps,desc_a,stopdat,info) + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + itx = 0 + restart: do +!!$ +!!$ r0 = b-ax0 +!!$ + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),' restart: ',itx,it + if (itx >= itmax_) exit restart + + it = 0 + call psb_geaxpby(cone,b,czero,r,desc_a,info) + if (info == psb_success_) call psb_spmm(-cone,a,x,cone,r,desc_a,info,work=aux) + + if (info == psb_success_) call prec%apply(r,desc_a,info) + + if (info == psb_success_) call psb_geaxpby(cone,r,czero,rt0,desc_a,info) + if (info == psb_success_) call psb_geaxpby(cone,r,czero,rh(0),desc_a,info) + if (info == psb_success_) call psb_geaxpby(czero,r,czero,uh(0),desc_a,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + rho = cone + alpha = czero + omega = cone + + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' on entry to amax: b: ',b%get_nrows() + + if (psb_check_conv(methdname,itx,x,r,desc_a,stopdat,info)) exit restart + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + iteration: do + it = it + nl + itx = itx + nl + rho = -omega*rho + + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' iteration: ',itx, rho + + do j = 0, nl -1 + If (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),'bicg part: ',j, nl + + rho_old = rho + rho = psb_gedot(rh(j),rt0,desc_a,info) + if (rho == czero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' bi-cgstab iteration breakdown r',rho + exit iteration + endif + + beta = alpha*rho/rho_old + rho_old = rho + do k=0, j +!!$ call psb_geaxpby(cone,rh(:,0:j),-beta,uh(:,0:j),desc_a,info) + call psb_geaxpby(cone,rh(k),-beta,uh(k),desc_a,info) + end do + call psb_spmm(cone,a,uh(j),czero,uh(j+1),desc_a,info,work=aux) + + call prec%apply(uh(j+1),desc_a,info) + + gamma(j) = psb_gedot(uh(j+1),rt0,desc_a,info) + + if (gamma(j) == czero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' bi-cgstab iteration breakdown s2',gamma(j) + exit iteration + endif + alpha = rho/gamma(j) + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' bicg part: alpha=r/g ',alpha,rho,gamma(j) + + do k=0,j +!!$ call psb_geaxpby(-alpha,uh(:,1:j+1),cone,rh(:,0:j),desc_a,info) + call psb_geaxpby(-alpha,uh(k+1),cone,rh(k),desc_a,info) + end do + call psb_geaxpby(alpha,uh(0),cone,x,desc_a,info) + call psb_spmm(cone,a,rh(j),czero,rh(j+1),desc_a,info,work=aux) + + call prec%apply(rh(j+1),desc_a,info) + + enddo + + do j=1, nl + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' mod g-s part: ',j, nl + + do i=1, j-1 + taum(i,j) = psb_gedot(rh(i),rh(j),desc_a,info) + taum(i,j) = taum(i,j)/sigma(i) + call psb_geaxpby(-taum(i,j),rh(i),cone,rh(j),desc_a,info) + enddo + sigma(j) = psb_gedot(rh(j),rh(j),desc_a,info) + gamma1(j) = psb_gedot(rh(0),rh(j),desc_a,info) + gamma1(j) = gamma1(j)/sigma(j) + enddo + + gamma(nl) = gamma1(nl) + omega = gamma(nl) + + do j=nl-1,1,-1 + gamma(j) = gamma1(j) + do i=j+1,nl + gamma(j) = gamma(j) - taum(j,i) * gamma(i) + enddo + enddo + + do j=1,nl-1 + gamma2(j) = gamma(j+1) + do i=j+1,nl-1 + gamma2(j) = gamma2(j) + taum(j,i) * gamma(i+1) + enddo + enddo + + call psb_geaxpby(gamma(1),rh(0),cone,x,desc_a,info) + call psb_geaxpby(-gamma1(nl),rh(nl),cone,rh(0),desc_a,info) + call psb_geaxpby(-gamma(nl),uh(nl),cone,uh(0),desc_a,info) + + do j=1, nl-1 + call psb_geaxpby(-gamma(j),uh(j),cone,uh(0),desc_a,info) + call psb_geaxpby(gamma2(j),rh(j),cone,x,desc_a,info) + call psb_geaxpby(-gamma1(j),rh(j),cone,rh(0),desc_a,info) + enddo + + if (psb_check_conv(methdname,itx,x,rh(0),desc_a,stopdat,info)) exit restart + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + end do iteration + end do restart + + call psb_end_conv(methdname,itx,desc_a,stopdat,info,derr,iter) + if (present(err)) err = derr + + if (info == psb_success_) call psb_gefree(uh,desc_a,info) + if (info == psb_success_) call psb_gefree(rh,desc_a,info) + if (info == psb_success_) call psb_gefree(wwrk,desc_a,info) + if (info == psb_success_) deallocate(aux,stat=info) + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + + ! restore external global coherence behaviour + call psb_restore_coher(ictxt,isvch) + 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 psb_ccgstabl_vect + + + diff --git a/krylov/psb_ckrylov.f90 b/krylov/psb_ckrylov.f90 index 3272ce4e9..19ebb514d 100644 --- a/krylov/psb_ckrylov.f90 +++ b/krylov/psb_ckrylov.f90 @@ -244,3 +244,175 @@ Subroutine psb_ckrylov(method,a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,i end subroutine psb_ckrylov +Subroutine psb_ckrylov_vect(method,a,prec,b,x,eps,desc_a,info,& + & itmax,iter,err,itrace,irst,istop,cond) + + use psb_base_mod + use psb_prec_mod,only : psb_cprec_type + use psb_krylov_mod, psb_protect_name => psb_ckrylov_vect + + character(len=*) :: method + Type(psb_cspmat_type), Intent(in) :: a + Type(psb_desc_type), Intent(in) :: desc_a + class(psb_cprec_type), intent(inout) :: prec + type(psb_c_vect_type), Intent(inout) :: b + type(psb_c_vect_type), Intent(inout) :: x + Real(psb_spk_), Intent(in) :: eps + integer, intent(out) :: info + Integer, Optional, Intent(in) :: itmax, itrace, irst,istop + Integer, Optional, Intent(out) :: iter + Real(psb_spk_), Optional, Intent(out) :: err,cond + + interface + subroutine psb_ccg_vect(a,prec,b,x,eps,& + & desc_a,info,itmax,iter,err,itrace,istop,cond) + use psb_base_mod, only : psb_desc_type, psb_cspmat_type,& + & psb_spk_, psb_c_vect_type + use psb_prec_mod, only : psb_cprec_type + type(psb_cspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + class(psb_cprec_type), intent(inout) :: prec + type(psb_c_vect_type), Intent(inout) :: b + type(psb_c_vect_type), Intent(inout) :: x + real(psb_spk_), intent(in) :: eps + integer, intent(out) :: info + integer, optional, intent(in) :: itmax, itrace,istop + integer, optional, intent(out) :: iter + real(psb_spk_), optional, intent(out) :: err,cond + end subroutine psb_ccg_vect + subroutine psb_cbicg_vect(a,prec,b,x,eps,& + & desc_a,info,itmax,iter,err,itrace,istop) + use psb_base_mod, only : psb_desc_type, psb_cspmat_type,& + & psb_spk_, psb_c_vect_type + use psb_prec_mod, only : psb_cprec_type + type(psb_cspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + class(psb_cprec_type), intent(inout) :: prec + type(psb_c_vect_type), Intent(inout) :: b + type(psb_c_vect_type), Intent(inout) :: x + real(psb_spk_), intent(in) :: eps + integer, intent(out) :: info + integer, optional, intent(in) :: itmax, itrace,istop + integer, optional, intent(out) :: iter + real(psb_spk_), optional, intent(out) :: err + end subroutine psb_cbicg_vect + subroutine psb_ccgstab_vect(a,prec,b,x,eps,& + & desc_a,info,itmax,iter,err,itrace,istop) + use psb_base_mod, only : psb_desc_type, psb_cspmat_type,& + & psb_spk_, psb_c_vect_type + use psb_prec_mod, only : psb_cprec_type + type(psb_cspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + type(psb_c_vect_type), Intent(inout) :: b + type(psb_c_vect_type), Intent(inout) :: x + real(psb_spk_), intent(in) :: eps + class(psb_cprec_type), intent(inout) :: prec + integer, intent(out) :: info + integer, optional, intent(in) :: itmax, itrace,istop + integer, optional, intent(out) :: iter + real(psb_spk_), optional, intent(out) :: err + end subroutine psb_ccgstab_vect + Subroutine psb_ccgstabl_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err, itrace,irst,istop) + use psb_base_mod, only : psb_desc_type, psb_cspmat_type, & + & psb_spk_, psb_c_vect_type + use psb_prec_mod, only : psb_cprec_type + Type(psb_cspmat_type), Intent(in) :: a + Type(psb_desc_type), Intent(in) :: desc_a + class(psb_cprec_type), intent(inout) :: prec + type(psb_c_vect_type), Intent(inout) :: b + type(psb_c_vect_type), Intent(inout) :: x + Real(psb_spk_), Intent(in) :: eps + integer, intent(out) :: info + Integer, Optional, Intent(in) :: itmax, itrace, irst,istop + Integer, Optional, Intent(out) :: iter + Real(psb_spk_), Optional, Intent(out) :: err + end subroutine psb_ccgstabl_vect + Subroutine psb_crgmres_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err,itrace,irst,istop) + use psb_base_mod, only : psb_desc_type, psb_cspmat_type,& + & psb_spk_, psb_c_vect_type + use psb_prec_mod, only : psb_cprec_type + Type(psb_cspmat_type), Intent(in) :: a + Type(psb_desc_type), Intent(in) :: desc_a + class(psb_cprec_type), intent(inout) :: prec + type(psb_c_vect_type), Intent(inout) :: b + type(psb_c_vect_type), Intent(inout) :: x + Real(psb_spk_), Intent(in) :: eps + integer, intent(out) :: info + Integer, Optional, Intent(in) :: itmax, itrace, irst,istop + Integer, Optional, Intent(out) :: iter + Real(psb_spk_), Optional, Intent(out) :: err + end subroutine psb_crgmres_vect + subroutine psb_ccgs_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err,itrace,istop) + use psb_base_mod, only : psb_desc_type, psb_cspmat_type,& + & psb_spk_, psb_c_vect_type + use psb_prec_mod, only : psb_cprec_type + type(psb_cspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + class(psb_cprec_type), intent(inout) :: prec + type(psb_c_vect_type), Intent(inout) :: b + type(psb_c_vect_type), Intent(inout) :: x + real(psb_spk_), intent(in) :: eps + integer, intent(out) :: info + integer, optional, intent(in) :: itmax, itrace,istop + integer, optional, intent(out) :: iter + real(psb_spk_), optional, intent(out) :: err + end subroutine psb_ccgs_vect + end interface + integer :: ictxt,me,np,err_act + character(len=20) :: name + + info = psb_success_ + name = 'psb_krylov' + call psb_erractionsave(err_act) + + ictxt=desc_a%get_context() + + call psb_info(ictxt, me, np) + + select case(psb_toupper(method)) + case('CG') + call psb_ccg_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err,itrace,istop,cond) + case('CGS') + call psb_ccgs_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err,itrace,istop) + case('BICG') + call psb_cbicg_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err,itrace,istop) + case('BICGSTAB') + call psb_ccgstab_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err,itrace,istop) + case('RGMRES') + call psb_crgmres_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err,itrace,irst,istop) + case('BICGSTABL') + call psb_ccgstabl_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err,itrace,irst,istop) + case default + if (me == 0) write(psb_err_unit,*) trim(name),& + & ': Warning: Unknown method ',method,& + & ', defaulting to BiCGSTAB' + call psb_ccgstab_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err,itrace,istop) + end select + + if(info /= psb_success_) 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(ictxt) + return + end if + +end subroutine psb_ckrylov_vect + diff --git a/krylov/psb_crgmres.f90 b/krylov/psb_crgmres.f90 index ce8c300b0..2a9b83996 100644 --- a/krylov/psb_crgmres.f90 +++ b/krylov/psb_crgmres.f90 @@ -108,7 +108,7 @@ Subroutine psb_crgmres(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,istop) use psb_base_mod use psb_prec_mod - use psb_inner_krylov_mod + use psb_c_inner_krylov_mod use psb_krylov_mod implicit none @@ -589,3 +589,502 @@ contains return end subroutine crotg End Subroutine psb_crgmres + + + +subroutine psb_crgmres_vect(a,prec,b,x,eps,desc_a,info,& + & itmax,iter,err,itrace,irst,istop) + use psb_base_mod + use psb_prec_mod + use psb_c_inner_krylov_mod + use psb_krylov_mod + implicit none + type(psb_cspmat_type), intent(in) :: a + Type(psb_desc_type), Intent(in) :: desc_a + class(psb_cprec_type), intent(inout) :: prec + type(psb_c_vect_type), Intent(inout) :: b + type(psb_c_vect_type), Intent(inout) :: x + Real(psb_spk_), Intent(in) :: eps + integer, intent(out) :: info + Integer, Optional, Intent(in) :: itmax, itrace, irst,istop + Integer, Optional, Intent(out) :: iter + Real(psb_spk_), Optional, Intent(out) :: err +!!$ local data + complex(psb_spk_), allocatable :: aux(:) + complex(psb_spk_), allocatable :: c(:), s(:), h(:,:), rs(:), rst(:) + type(psb_c_vect_type), allocatable :: v(:) + type(psb_c_vect_type) :: w, w1, xt + real(psb_spk_) :: tmp + complex(psb_spk_) :: scal, gm, rti, rti1 + Integer ::litmax, naux, mglob, it,k, itrace_,& + & np,me, n_row, n_col, nl, int_err(5) + Logical, Parameter :: exchange=.True., noexchange=.False., use_srot=.true. + Integer, Parameter :: irmax = 8 + Integer :: itx, i, isvch, ictxt,istop_, err_act + integer :: debug_level, debug_unit + Real(psb_spk_) :: rni, xni, bni, ani,bn2, dt + real(psb_dpk_) :: errnum, errden, deps, derr + character(len=20) :: name + character(len=*), parameter :: methdname='RGMRES' + + info = psb_success_ + name = 'psb_sgmres' + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt = desc_a%get_context() + Call psb_info(ictxt, me, np) + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),': from psb_info',np + if (.not.allocated(b%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + mglob = desc_a%get_global_rows() + n_row = desc_a%get_local_rows() + n_col = desc_a%get_local_cols() + + if (present(istop)) then + istop_ = istop + else + istop_ = 2 + endif +! +! ISTOP_ = 1: Normwise backward error, infinity norm +! ISTOP_ = 2: ||r||/||b||, 2-norm +! + + if ((istop_ < 1 ).or.(istop_ > 2 ) ) then + info=psb_err_invalid_istop_ + int_err(1)=istop_ + err=info + call psb_errpush(info,name,i_err=int_err) + goto 9999 + endif + + if (present(itmax)) then + litmax = itmax + else + litmax = 1000 + endif + + if (present(itrace)) then + itrace_ = itrace + else + itrace_ = 0 + end if + + if (present(irst)) then + nl = irst + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' present: irst: ',irst,nl + else + nl = 10 + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' not present: irst: ',irst,nl + endif + if (nl <=0 ) then + info=psb_err_invalid_istop_ + int_err(1)=nl + err=info + call psb_errpush(info,name,i_err=int_err) + goto 9999 + endif + + call psb_chkvect(mglob,1,x%get_nrows(),1,1,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_chkvect on X') + goto 9999 + end if + call psb_chkvect(mglob,1,b%get_nrows(),1,1,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_chkvect on B') + goto 9999 + end if + + + naux=4*n_col + allocate(aux(naux),h(nl+1,nl+1),& + &c(nl+1),s(nl+1),rs(nl+1), rst(nl+1),stat=info) + + if (info == psb_success_) call psb_geall(v,desc_a,info,n=nl+1) + if (info == psb_success_) call psb_geall(w,desc_a,info) + if (info == psb_success_) call psb_geall(w1,desc_a,info) + if (info == psb_success_) call psb_geall(xt,desc_a,info) + if (info == psb_success_) call psb_geasb(v,desc_a,info,mold=x%v) + if (info == psb_success_) call psb_geasb(w,desc_a,info,mold=x%v) + if (info == psb_success_) call psb_geasb(w1,desc_a,info,mold=x%v) + if (info == psb_success_) call psb_geasb(xt,desc_a,info,mold=x%v) + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' Size of V,W,W1 ',v(1)%get_nrows(),size(v),& + & w%get_nrows(),w1%get_nrows() + + ! Ensure global coherence for convergence checks. + call psb_set_coher(ictxt,isvch) + + if (istop_ == 1) then + ani = psb_spnrmi(a,desc_a,info) + bni = psb_geamax(b,desc_a,info) + else if (istop_ == 2) then + bn2 = psb_genrm2(b,desc_a,info) + endif + errnum = czero + errden = cone + deps = eps + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + if ((itrace_ > 0).and.(me == 0)) call log_header(methdname) + + itx = 0 + restart: do + + ! compute r0 = b-ax0 + ! check convergence + ! compute v1 = r0/||r0||_2 + + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' restart: ',itx,it + it = 0 + call psb_geaxpby(cone,b,czero,v(1),desc_a,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + call psb_spmm(-cone,a,x,cone,v(1),desc_a,info,work=aux) + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + rs(1) = psb_genrm2(v(1),desc_a,info) + rs(2:) = czero + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + scal=cone/rs(1) ! rs(1) MIGHT BE VERY SMALL - USE DSCAL TO DEAL WITH IT? + + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' on entry to amax: b: ',b%get_nrows(),rs(1),scal + + ! + ! check convergence + ! + if (istop_ == 1) then + rni = psb_geamax(v(1),desc_a,info) + xni = psb_geamax(x,desc_a,info) + errnum = rni + errden = (ani*xni+bni) + else if (istop_ == 2) then + rni = psb_genrm2(v(1),desc_a,info) + errnum = rni + errden = bn2 + endif + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + if (errnum <= eps*errden) exit restart + + if (itrace_ > 0) & + & call log_conv(methdname,me,itx,itrace_,errnum,errden,deps) + + call v(1)%scal(scal) !v(1) = v(1) * scal + + if (itx >= litmax) exit restart + + ! + ! inner iterations + ! + + inner: Do i=1,nl + itx = itx + 1 + + call prec%apply(v(i),w1,desc_a,info) + call psb_spmm(cone,a,w1,czero,w,desc_a,info,work=aux) + ! + + do k = 1, i + h(k,i) = psb_gedot(v(k),w,desc_a,info) + call psb_geaxpby(-h(k,i),v(k),cone,w,desc_a,info) + end do + h(i+1,i) = psb_genrm2(w,desc_a,info) + scal=cone/h(i+1,i) + call psb_geaxpby(scal,w,czero,v(i+1),desc_a,info) + do k=2,i + call crot(1,h(k-1,i),1,h(k,i),1,real(c(k-1)),s(k-1)) + enddo + + + rti = h(i,i) + rti1 = h(i+1,i) + call crotg(rti,rti1,tmp,s(i)) + c(i) = cmplx(tmp,szero) + call crot(1,h(i,i),1,h(i+1,i),1,real(c(i)),s(i)) + h(i+1,i) = czero + call crot(1,rs(i),1,rs(i+1),1,real(c(i)),s(i)) + + if (istop_ == 1) then + ! + ! build x and then compute the residual and its infinity norm + ! + rst = rs + call w1%set(czero) + call ctrsm('l','u','n','n',i,1,cone,h,size(h,1),rst,size(rst,1)) + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' Rebuild x-> RS:',rst(1:nl) + do k=1, i + call psb_geaxpby(rst(k),v(k),cone,xt,desc_a,info) + end do + call prec%apply(xt,desc_a,info) + call psb_geaxpby(cone,x,cone,xt,desc_a,info) + call psb_geaxpby(cone,b,czero,w1,desc_a,info) + call psb_spmm(-cone,a,xt,cone,w1,desc_a,info,work=aux) + rni = psb_geamax(w1,desc_a,info) + xni = psb_geamax(xt,desc_a,info) + errnum = rni + errden = (ani*xni+bni) + ! + + else if (istop_ == 2) then + ! + ! compute the residual 2-norm as byproduct of the solution + ! procedure of the least-squares problem + ! + rni = abs(rs(i+1)) + errnum = rni + errden = bn2 + endif + + if (errnum <= eps*errden) then + + if (istop_ == 1) then + call psb_geaxpby(cone,xt,czero,x,desc_a,info) +!!$ x = xt + else if (istop_ == 2) then + ! + ! build x + ! + call ctrsm('l','u','n','n',i,1,cone,h,size(h,1),rs,size(rs,1)) + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' Rebuild x-> RS:',rs(1:nl) + call w1%set(czero) + do k=1, i + call psb_geaxpby(rs(k),v(k),cone,w1,desc_a,info) + end do + call prec%apply(w1,w,desc_a,info) + call psb_geaxpby(cone,w,cone,x,desc_a,info) + end if + + exit restart + + end if + + if (itrace_ > 0) & + & call log_conv(methdname,me,itx,itrace_,errnum,errden,deps) + + end do inner + + if (istop_ == 1) then + call psb_geaxpby(cone,xt,czero,x,desc_a,info)! x = xt + else if (istop_ == 2) then + ! + ! build x + ! + call ctrsm('l','u','n','n',nl,1,cone,h,size(h,1),rs,size(rs,1)) + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' Rebuild x-> RS:',rs(1:nl) + call w1%set(czero) + do k=1, nl + call psb_geaxpby(rs(k),v(k),cone,w1,desc_a,info) + end do + call prec%apply(w1,w,desc_a,info) + call psb_geaxpby(cone,w,cone,x,desc_a,info) + end if + + end do restart + if (itrace_ > 0) & + & call log_conv(methdname,me,itx,1,errnum,errden,deps) + + call log_end(methdname,me,itx,errnum,errden,deps,err=derr,iter=iter) + if (present(err)) err = derr + + + if (info == psb_success_) call psb_gefree(v,desc_a,info) + if (info == psb_success_) call psb_gefree(w,desc_a,info) + if (info == psb_success_) call psb_gefree(w1,desc_a,info) + if (info == psb_success_) call psb_gefree(xt,desc_a,info) + if (info == psb_success_) deallocate(aux,h,c,s,rs,rst, stat=info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + ! restore external global coherence behaviour + call psb_restore_coher(ictxt,isvch) + + 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 crot( n, cx, incx, cy, incy, c, s ) + ! + ! -- lapack auxiliary routine (version 3.0) -- + ! univ. of tennessee, univ. of california berkeley, nag ltd., + ! courant institute, argonne national lab, and rice university + ! october 31, 1992 + ! + ! .. scalar arguments .. + integer incx, incy, n + real(psb_spk_) c + complex(psb_spk_) s + ! .. + ! .. array arguments .. + complex(psb_spk_) cx( * ), cy( * ) + ! .. + ! + ! purpose + ! == = ==== + ! + ! zrot applies a plane rotation, where the cos (c) is real and the + ! sin (s) is complex, and the vectors cx and cy are complex. + ! + ! arguments + ! == = ====== + ! + ! n (input) integer + ! the number of elements in the vectors cx and cy. + ! + ! cx (input/output) complex*16 array, dimension (n) + ! on input, the vector x. + ! on output, cx is overwritten with c*x + s*y. + ! + ! incx (input) integer + ! the increment between successive values of cy. incx <> 0. + ! + ! cy (input/output) complex*16 array, dimension (n) + ! on input, the vector y. + ! on output, cy is overwritten with -conjg(s)*x + c*y. + ! + ! incy (input) integer + ! the increment between successive values of cy. incx <> 0. + ! + ! c (input) double precision + ! s (input) complex*16 + ! c and s define a rotation + ! [ c s ] + ! [ -conjg(s) c ] + ! where c*c + s*conjg(s) = 1.0. + ! + ! == = ================================================================== + ! + ! .. local scalars .. + integer i, ix, iy + complex(psb_dpk_) stemp + ! .. + ! .. intrinsic functions .. + ! .. + ! .. executable statements .. + ! + if( n <= 0 ) return + if( incx == 1 .and. incy == 1 ) then + ! + ! code for both increments equal to 1 + ! + do i = 1, n + stemp = c*cx(i) + s*cy(i) + cy(i) = c*cy(i) - conjg(s)*cx(i) + cx(i) = stemp + end do + else + ! + ! code for unequal increments or equal increments not equal to 1 + ! + ix = 1 + iy = 1 + if( incx < 0 )ix = ( -n+1 )*incx + 1 + if( incy < 0 )iy = ( -n+1 )*incy + 1 + do i = 1, n + stemp = c*cx(ix) + s*cy(iy) + cy(iy) = c*cy(iy) - conjg(s)*cx(ix) + cx(ix) = stemp + ix = ix + incx + iy = iy + incy + end do + end if + return + end subroutine crot + ! + ! + subroutine crotg(ca,cb,c,s) + complex(psb_spk_) ca,cb,s + real(psb_spk_) c + real(psb_spk_) norm,scale + complex(psb_spk_) alpha + ! + if (cabs(ca) == 0.0) then + ! + c = 0.0d0 + s = (1.0,0.0) + ca = cb + return + end if + ! + + scale = cabs(ca) + cabs(cb) + norm = scale*sqrt((cabs(ca/cmplx(scale,0.0)))**2 +& + & (cabs(cb/cmplx(scale,0.0)))**2) + alpha = ca /cabs(ca) + c = cabs(ca) / norm + s = alpha * conjg(cb) / norm + ca = alpha * norm + ! + + return + end subroutine crotg + +end subroutine psb_crgmres_vect + diff --git a/krylov/psb_d_inner_krylov_mod.f90 b/krylov/psb_d_inner_krylov_mod.f90 index cbcadd9e6..5c8b853ca 100644 --- a/krylov/psb_d_inner_krylov_mod.f90 +++ b/krylov/psb_d_inner_krylov_mod.f90 @@ -38,11 +38,11 @@ Module psb_d_inner_krylov_mod use psb_base_inner_krylov_mod interface psb_init_conv - module procedure psb_d_init_conv + module procedure psb_d_init_conv, psb_d_init_conv_vect end interface interface psb_check_conv - module procedure psb_d_check_conv + module procedure psb_d_check_conv, psb_d_check_conv_vect end interface @@ -55,7 +55,7 @@ contains character(len=*), intent(in) :: methdname integer, intent(in) :: stopc, trace,itmax type(psb_dspmat_type), intent(in) :: a - real(psb_dpk_), intent(in) :: b(:), eps + real(psb_dpk_), intent(in) :: b(:), eps type(psb_desc_type), intent(in) :: desc_a type(psb_itconv_type) :: stopdat integer, intent(out) :: info @@ -116,15 +116,15 @@ contains end subroutine psb_d_init_conv - function psb_d_check_conv(methdname,it,x,r,desc_a,stopdat,info) + function psb_d_check_conv(methdname,it,x,r,desc_a,stopdat,info) result(res) use psb_base_mod implicit none character(len=*), intent(in) :: methdname integer, intent(in) :: it - real(psb_dpk_), intent(in) :: x(:), r(:) + real(psb_dpk_), intent(in) :: x(:), r(:) type(psb_desc_type), intent(in) :: desc_a type(psb_itconv_type) :: stopdat - logical :: psb_d_check_conv + logical :: res integer, intent(out) :: info integer :: ictxt, me, np, err_act @@ -137,15 +137,17 @@ contains ictxt = desc_a%get_context() call psb_info(ictxt,me,np) - psb_d_check_conv = .false. + res = .false. select case(stopdat%controls(psb_ik_stopc_)) case(1) stopdat%values(psb_ik_rni_) = psb_geamax(r,desc_a,info) - if (info == psb_success_) stopdat%values(psb_ik_xni_) = psb_geamax(x,desc_a,info) + if (info == psb_success_)& + & stopdat%values(psb_ik_xni_) = psb_geamax(x,desc_a,info) stopdat%values(psb_ik_errnum_) = stopdat%values(psb_ik_rni_) stopdat%values(psb_ik_errden_) = & - & (stopdat%values(psb_ik_ani_)*stopdat%values(psb_ik_xni_)+stopdat%values(psb_ik_bni_)) + & (stopdat%values(psb_ik_ani_)*stopdat%values(psb_ik_xni_)& + & +stopdat%values(psb_ik_bni_)) case(2) stopdat%values(psb_ik_rn2_) = psb_genrm2(r,desc_a,info) stopdat%values(psb_ik_errnum_) = stopdat%values(psb_ik_rn2_) @@ -163,16 +165,16 @@ contains end if if (stopdat%values(psb_ik_errden_) == dzero) then - psb_d_check_conv = (stopdat%values(psb_ik_errnum_) <= stopdat%values(psb_ik_eps_)) + res = (stopdat%values(psb_ik_errnum_) <= stopdat%values(psb_ik_eps_)) else - psb_d_check_conv = & - & (stopdat%values(psb_ik_errnum_) <= stopdat%values(psb_ik_eps_)*stopdat%values(psb_ik_errden_)) + res = (stopdat%values(psb_ik_errnum_) <= & + & stopdat%values(psb_ik_eps_)*stopdat%values(psb_ik_errden_)) end if - psb_d_check_conv = (psb_d_check_conv.or.(stopdat%controls(psb_ik_itmax_) <= it)) + res = (res.or.(stopdat%controls(psb_ik_itmax_) <= it)) if ( (stopdat%controls(psb_ik_trace_) > 0).and.& - & ((mod(it,stopdat%controls(psb_ik_trace_)) == 0).or.psb_d_check_conv)) then + & ((mod(it,stopdat%controls(psb_ik_trace_)) == 0).or.res)) then call log_conv(methdname,me,it,1,stopdat%values(psb_ik_errnum_),& & stopdat%values(psb_ik_errden_),stopdat%values(psb_ik_eps_)) end if @@ -189,5 +191,150 @@ contains end function psb_d_check_conv + subroutine psb_d_init_conv_vect(methdname,stopc,trace,itmax,a,b,eps,desc_a,stopdat,info) + use psb_base_mod + implicit none + character(len=*), intent(in) :: methdname + integer, intent(in) :: stopc, trace,itmax + type(psb_dspmat_type), intent(in) :: a + real(psb_dpk_), intent(in) :: eps + type(psb_d_vect_type), intent(inout) :: b + type(psb_desc_type), intent(in) :: desc_a + type(psb_itconv_type) :: stopdat + integer, intent(out) :: info + + integer :: ictxt, me, np, err_act + character(len=20) :: name + + info = psb_success_ + name = 'psb_init_conv' + call psb_erractionsave(err_act) + + + ictxt=desc_a%get_context() + + call psb_info(ictxt, me, np) + + stopdat%controls(:) = 0 + stopdat%values(:) = 0.0d0 + + stopdat%controls(psb_ik_stopc_) = stopc + stopdat%controls(psb_ik_trace_) = trace + stopdat%controls(psb_ik_itmax_) = itmax + + select case(stopdat%controls(psb_ik_stopc_)) + case (1) + stopdat%values(psb_ik_ani_) = psb_spnrmi(a,desc_a,info) + if (info == psb_success_)& + & stopdat%values(psb_ik_bni_) = psb_geamax(b,desc_a,info) + + case (2) + stopdat%values(psb_ik_bn2_) = psb_genrm2(b,desc_a,info) + + case default + info=psb_err_invalid_istop_ + call psb_errpush(info,name,i_err=(/stopc,0,0,0,0/)) + goto 9999 + end select + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,a_err="Init conv check data") + goto 9999 + end if + + stopdat%values(psb_ik_eps_) = eps + stopdat%values(psb_ik_errnum_) = dzero + stopdat%values(psb_ik_errden_) = done + + if ((stopdat%controls(psb_ik_trace_) > 0).and. (me == 0))& + & call log_header(methdname) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + + end subroutine psb_d_init_conv_vect + + function psb_d_check_conv_vect(methdname,it,x,r,desc_a,stopdat,info) result(res) + use psb_base_mod + implicit none + character(len=*), intent(in) :: methdname + integer, intent(in) :: it + type(psb_d_vect_type), intent(inout) :: x, r + type(psb_desc_type), intent(in) :: desc_a + type(psb_itconv_type) :: stopdat + logical :: res + integer, intent(out) :: info + + integer :: ictxt, me, np, err_act + character(len=20) :: name + + info = psb_success_ + res = .false. + if (psb_errstatus_fatal()) return + name = 'psb_check_conv' + call psb_erractionsave(err_act) + + ictxt = desc_a%get_context() + call psb_info(ictxt,me,np) + + + + select case(stopdat%controls(psb_ik_stopc_)) + case(1) + stopdat%values(psb_ik_rni_) = psb_geamax(r,desc_a,info) + if (info == psb_success_) stopdat%values(psb_ik_xni_) = psb_geamax(x,desc_a,info) + stopdat%values(psb_ik_errnum_) = stopdat%values(psb_ik_rni_) + stopdat%values(psb_ik_errden_) = & + & (stopdat%values(psb_ik_ani_)*stopdat%values(psb_ik_xni_)& + & +stopdat%values(psb_ik_bni_)) + case(2) + stopdat%values(psb_ik_rn2_) = psb_genrm2(r,desc_a,info) + stopdat%values(psb_ik_errnum_) = stopdat%values(psb_ik_rn2_) + stopdat%values(psb_ik_errden_) = stopdat%values(psb_ik_bn2_) + + case default + info=psb_err_internal_error_ + call psb_errpush(info,name,a_err="Control data in stopdat messed up!") + goto 9999 + end select + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + if (stopdat%values(psb_ik_errden_) == dzero) then + res = (stopdat%values(psb_ik_errnum_) <= stopdat%values(psb_ik_eps_)) + else + res = (stopdat%values(psb_ik_errnum_) <=& + & stopdat%values(psb_ik_eps_)*stopdat%values(psb_ik_errden_)) + end if + + res = (res.or.(stopdat%controls(psb_ik_itmax_) <= it)) + + if ( (stopdat%controls(psb_ik_trace_) > 0).and.& + & ((mod(it,stopdat%controls(psb_ik_trace_)) == 0).or.res)) then + call log_conv(methdname,me,it,1,stopdat%values(psb_ik_errnum_),& + & stopdat%values(psb_ik_errden_),stopdat%values(psb_ik_eps_)) + 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(ictxt) + return + end if + + end function psb_d_check_conv_vect + end module psb_d_inner_krylov_mod diff --git a/krylov/psb_dbicg.f90 b/krylov/psb_dbicg.f90 index 40b93fe21..848e82e91 100644 --- a/krylov/psb_dbicg.f90 +++ b/krylov/psb_dbicg.f90 @@ -97,7 +97,7 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) use psb_base_mod use psb_prec_mod - use psb_inner_krylov_mod + use psb_d_inner_krylov_mod use psb_krylov_mod implicit none type(psb_dspmat_type), intent(in) :: a @@ -329,4 +329,250 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) end subroutine psb_dbicg +subroutine psb_dbicg_vect(a,prec,b,x,eps,desc_a,info,& + & itmax,iter,err,itrace,istop) + use psb_base_mod + use psb_prec_mod + use psb_d_inner_krylov_mod + use psb_krylov_mod + implicit none + type(psb_dspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + class(psb_dprec_type), intent(inout) :: prec + type(psb_d_vect_type), Intent(inout) :: b + type(psb_d_vect_type), Intent(inout) :: x + real(psb_dpk_), intent(in) :: eps + integer, intent(out) :: info + integer, optional, intent(in) :: itmax, itrace, istop + integer, optional, intent(out) :: iter + real(psb_dpk_), optional, intent(out) :: err +!!$ local data + real(psb_dpk_), allocatable, target :: aux(:) + type(psb_d_vect_type), allocatable, target :: wwrk(:) + type(psb_d_vect_type), pointer :: ww, q, r, p,& + & zt, pt, z, rt, qt + integer :: int_err(5) + integer :: itmax_, naux, mglob, it, itrace_,& + & np,me, n_row, n_col, istop_, err_act + integer :: debug_level, debug_unit + logical, parameter :: exchange=.true., noexchange=.false. + integer, parameter :: irmax = 8 + integer :: itx, isvch, ictxt + real(psb_dpk_) :: alpha, beta, rho, rho_old, sigma + type(psb_itconv_type) :: stopdat + character(len=20) :: name,ch_err + character(len=*), parameter :: methdname='BiCG' + + info = psb_success_ + name = 'psb_dbicg' + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt = desc_a%get_context() + call psb_info(ictxt, me, np) + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),': from psb_info',np + + mglob = desc_a%get_global_rows() + n_row = desc_a%get_local_rows() + n_col = desc_a%get_local_cols() + + ! Ensure global coherence for convergence checks. + call psb_set_coher(ictxt,isvch) + + if (.not.allocated(b%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + if (present(istop)) then + istop_ = istop + else + istop_ = 2 + endif + ! + ! istop_ = 1: normwise backward error, infinity norm + ! istop_ = 2: ||r||/||b|| norm 2 + ! + + if ((istop_ < 1 ).or.(istop_ > 2 ) ) then + info=psb_err_invalid_istop_ + int_err=istop_ + err=info + call psb_errpush(info,name,i_err=int_err) + goto 9999 + endif + + call psb_chkvect(mglob,1,x%get_nrows(),1,1,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_chkvect on X') + goto 9999 + end if + call psb_chkvect(mglob,1,b%get_nrows(),1,1,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_chkvect on B') + goto 9999 + end if + + + naux=4*n_col + + allocate(aux(naux),stat=info) + if (info == psb_success_) call psb_geall(wwrk,desc_a,info,n=9) + if (info == psb_success_) call psb_geasb(wwrk,desc_a,info,mold=x%v) + if(info /= psb_success_) then + info=psb_err_from_subroutine_non_ + ch_err='psb_asb' + err=info + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + q => wwrk(1) + qt => wwrk(2) + r => wwrk(3) + rt => wwrk(4) + p => wwrk(5) + pt => wwrk(6) + z => wwrk(7) + zt => wwrk(8) + ww => wwrk(9) + + if (present(itmax)) then + itmax_ = itmax + else + itmax_ = 1000 + endif + + if (present(itrace)) then + itrace_ = itrace + else + itrace_ = 0 + end if + + itx = 0 + + + call psb_init_conv(methdname,istop_,itrace_,itmax_,a,b,eps,desc_a,stopdat,info) + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + restart: do +!!$ +!!$ r0 = b-ax0 +!!$ + if (itx >= itmax_) exit restart + it = 0 + call psb_geaxpby(done,b,dzero,r,desc_a,info) + if (info == psb_success_) call psb_spmm(-done,a,x,done,r,desc_a,info,work=aux) + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),' Done spmm',info + if (info == psb_success_) call psb_geaxpby(done,r,dzero,rt,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + rho = dzero + + ! Perhaps we already satisfy the convergence criterion... + if (psb_check_conv(methdname,itx,x,r,desc_a,stopdat,info)) exit restart + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + iteration: do + it = it + 1 + itx = itx + 1 + + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),'iteration: ',itx + + call prec%apply(r,z,desc_a,info,work=aux) + if (info == psb_success_) call prec%apply(rt,zt,desc_a,info,trans='t',work=aux) + + rho_old = rho + rho = psb_gedot(rt,z,desc_a,info) + if (rho == dzero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' iteration breakdown r',rho + exit iteration + endif + + if (it == 1) then + call psb_geaxpby(done,z,dzero,p,desc_a,info) + call psb_geaxpby(done,zt,dzero,pt,desc_a,info) + else + beta = (rho/rho_old) + call psb_geaxpby(done,z,beta,p,desc_a,info) + call psb_geaxpby(done,zt,beta,pt,desc_a,info) + end if + + call psb_spmm(done,a,p,dzero,q,desc_a,info,& + & work=aux) + call psb_spmm(done,a,pt,dzero,qt,desc_a,info,& + & work=aux,trans='t') + + sigma = psb_gedot(pt,q,desc_a,info) + if (sigma == dzero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' iteration breakdown s1', sigma + exit iteration + endif + + alpha = rho/sigma + + + call psb_geaxpby(alpha,p,done,x,desc_a,info) + call psb_geaxpby(-alpha,q,done,r,desc_a,info) + call psb_geaxpby(-alpha,qt,done,rt,desc_a,info) + + if (psb_check_conv(methdname,itx,x,r,desc_a,stopdat,info)) exit restart + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + end do iteration + end do restart + + call psb_end_conv(methdname,itx,desc_a,stopdat,info,err,iter) + + if (info == psb_success_) call psb_gefree(wwrk,desc_a,info) + if (info == psb_success_) deallocate(aux,stat=info) + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + ! restore external global coherence behaviour + call psb_restore_coher(ictxt,isvch) + + 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 psb_dbicg_vect + diff --git a/krylov/psb_dcg.F90 b/krylov/psb_dcg.F90 index 92f3844dd..b44924fab 100644 --- a/krylov/psb_dcg.F90 +++ b/krylov/psb_dcg.F90 @@ -98,24 +98,22 @@ subroutine psb_dcg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop,cond) use psb_base_mod use psb_prec_mod - use psb_inner_krylov_mod + use psb_d_inner_krylov_mod use psb_krylov_mod implicit none - type(psb_dspmat_type), intent(in) :: a - - - - class(psb_dprec_type), Intent(in) :: prec - Type(psb_desc_type), Intent(in) :: desc_a - Real(psb_dpk_), Intent(in) :: b(:) - Real(psb_dpk_), Intent(inout) :: x(:) - Real(psb_dpk_), Intent(in) :: eps - integer, intent(out) :: info - Integer, Optional, Intent(in) :: itmax, itrace, istop - Integer, Optional, Intent(out) :: iter + type(psb_dspmat_type), intent(in) :: a + Type(psb_desc_type), Intent(in) :: desc_a + class(psb_dprec_type), Intent(in) :: prec + Real(psb_dpk_), Intent(in) :: b(:) + Real(psb_dpk_), Intent(inout) :: x(:) + Real(psb_dpk_), Intent(in) :: eps + integer, intent(out) :: info + Integer, Optional, Intent(in) :: itmax, itrace, istop + Integer, Optional, Intent(out) :: iter Real(psb_dpk_), Optional, Intent(out) :: err,cond !!$ Local data - real(psb_dpk_), allocatable, target :: aux(:), wwrk(:,:), td(:),tu(:),eig(:),ewrk(:) + real(psb_dpk_), allocatable, target :: aux(:), wwrk(:,:),& + & td(:),tu(:),eig(:),ewrk(:) integer, allocatable :: ibl(:), ispl(:), iwrk(:) real(psb_dpk_), pointer :: q(:), p(:), r(:), z(:), w(:) real(psb_dpk_) :: alpha, beta, rho, rho_old, sigma,alpha_old,beta_old @@ -323,4 +321,242 @@ subroutine psb_dcg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop,cond) end subroutine psb_dcg +subroutine psb_dcg_vect(a,prec,b,x,eps,desc_a,info,& + & itmax,iter,err,itrace,istop,cond) + use psb_base_mod + use psb_prec_mod + use psb_d_inner_krylov_mod + use psb_krylov_mod + implicit none + type(psb_dspmat_type), intent(in) :: a + Type(psb_desc_type), Intent(in) :: desc_a + class(psb_dprec_type), intent(inout) :: prec + type(psb_d_vect_type), Intent(inout) :: b + type(psb_d_vect_type), Intent(inout) :: x + Real(psb_dpk_), Intent(in) :: eps + integer, intent(out) :: info + Integer, Optional, Intent(in) :: itmax, itrace, istop + Integer, Optional, Intent(out) :: iter + Real(psb_dpk_), Optional, Intent(out) :: err,cond +!!$ Local data + real(psb_dpk_), allocatable, target :: aux(:), td(:),tu(:),eig(:),ewrk(:) + integer, allocatable :: ibl(:), ispl(:), iwrk(:) + type(psb_d_vect_type), allocatable, target :: wwrk(:) + type(psb_d_vect_type), pointer :: q, p, r, z, w + real(psb_dpk_) :: alpha, beta, rho, rho_old, sigma,alpha_old,beta_old + integer :: itmax_, istop_, naux, mglob, it, itx, itrace_,& + & np,me, n_col, isvch, ictxt, n_row,err_act, int_err(5), ieg,nspl, istebz + integer :: debug_level, debug_unit + type(psb_itconv_type) :: stopdat + logical :: do_cond + character(len=20) :: name + character(len=*), parameter :: methdname='CG' + + info = psb_success_ + name = 'psb_dcg' + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt = desc_a%get_context() + + call psb_info(ictxt, me, np) + if (.not.allocated(b%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + mglob = desc_a%get_global_rows() + n_row = desc_a%get_local_rows() + n_col = desc_a%get_local_cols() + + + if (present(istop)) then + istop_ = istop + else + istop_ = 2 + endif + + call psb_chkvect(mglob,1,x%get_nrows(),1,1,desc_a,info) + if (info == psb_success_) call psb_chkvect(mglob,1,b%get_nrows(),1,1,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_chkvect on X/B') + goto 9999 + end if + + naux=4*n_col + allocate(aux(naux), stat=info) + if (info == psb_success_) call psb_geall(wwrk,desc_a,info,n=5) + if (info == psb_success_) call psb_geasb(wwrk,desc_a,info,mold=x%v) + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + p => wwrk(1) + q => wwrk(2) + r => wwrk(3) + z => wwrk(4) + w => wwrk(5) + + + if (present(itmax)) then + itmax_ = itmax + else + itmax_ = 1000 + endif + + if (present(itrace)) then + itrace_ = itrace + else + itrace_ = 0 + end if + + do_cond=present(cond) + if (do_cond) then + istebz = 0 + allocate(td(itmax_),tu(itmax_), eig(itmax_),& + & ibl(itmax_),ispl(itmax_),iwrk(3*itmax_),ewrk(4*itmax_),& + & stat=info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + end if + + itx=0 + + ! Ensure global coherence for convergence checks. + call psb_set_coher(ictxt,isvch) + + restart: do +!!$ +!!$ r0 = b-Ax0 +!!$ + if (itx>= itmax_) exit restart + + it = 0 + call psb_geaxpby(done,b,dzero,r,desc_a,info) + if (info == psb_success_) call psb_spmm(-done,a,x,done,r,desc_a,info,work=aux) + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + rho = dzero + + call psb_init_conv(methdname,istop_,itrace_,itmax_,a,b,eps,desc_a,stopdat,info) + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + iteration: do + + it = it + 1 + itx = itx + 1 + + call prec%apply(r,z,desc_a,info,work=aux) + rho_old = rho + rho = psb_gedot(r,z,desc_a,info) + + if (it == 1) then + call psb_geaxpby(done,z,dzero,p,desc_a,info) + else + if (rho_old == dzero) then + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),& + & ': CG Iteration breakdown rho' + exit iteration + endif + beta = rho/rho_old + call psb_geaxpby(done,z,beta,p,desc_a,info) + end if + + call psb_spmm(done,a,p,dzero,q,desc_a,info,work=aux) + sigma = psb_gedot(p,q,desc_a,info) + if (sigma == dzero) then + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),& + & ': CG Iteration breakdown sigma' + exit iteration + endif + alpha_old = alpha + alpha = rho/sigma + if (do_cond) then + istebz = istebz + 1 + if (istebz == 1) then + td(istebz) = done/alpha + else + td(istebz) = done/alpha + beta/alpha_old + tu(istebz-1) = sqrt(beta)/alpha_old + end if + end if + + call psb_geaxpby(alpha,p,done,x,desc_a,info) + call psb_geaxpby(-alpha,q,done,r,desc_a,info) + + if (psb_check_conv(methdname,itx,x,r,desc_a,stopdat,info)) exit restart + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + end do iteration + end do restart + + if (do_cond) then + if (me == 0) then +#if defined(HAVE_LAPACK) + call dstebz('A','E',istebz,dzero,dzero,0,0,-done,td,tu,& + & ieg,nspl,eig,ibl,ispl,ewrk,iwrk,info) + if (info < 0) then + call psb_errpush(psb_err_from_subroutine_ai_,name,a_err='dstebz',i_err=(/info,0,0,0,0/)) + info = psb_err_from_subroutine_ai_ + goto 9999 + end if + cond = eig(ieg)/eig(1) +#else + cond = -1.0 +#endif + info = psb_success_ + end if + call psb_bcast(ictxt,cond,root=0) + end if + call psb_end_conv(methdname,itx,desc_a,stopdat,info,err,iter) + + if (info == psb_success_) call psb_gefree(wwrk,desc_a,info) + if (info == psb_success_) deallocate(aux,stat=info) + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + + ! restore external global coherence behaviour + call psb_restore_coher(ictxt,isvch) + + 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 psb_dcg_vect + diff --git a/krylov/psb_dcgs.f90 b/krylov/psb_dcgs.f90 index f528c1fa0..48019fd19 100644 --- a/krylov/psb_dcgs.f90 +++ b/krylov/psb_dcgs.f90 @@ -97,14 +97,12 @@ Subroutine psb_dcgs(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) use psb_base_mod use psb_prec_mod - use psb_inner_krylov_mod + use psb_d_inner_krylov_mod use psb_krylov_mod implicit none type(psb_dspmat_type), intent(in) :: a - - - Type(psb_desc_type), Intent(in) :: desc_a class(psb_dprec_type), Intent(in) :: prec + Type(psb_desc_type), Intent(in) :: desc_a Real(psb_dpk_), Intent(in) :: b(:) Real(psb_dpk_), Intent(inout) :: x(:) Real(psb_dpk_), Intent(in) :: eps @@ -323,3 +321,243 @@ Subroutine psb_dcgs(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) return End Subroutine psb_dcgs + +Subroutine psb_dcgs_vect(a,prec,b,x,eps,desc_a,info,& + & itmax,iter,err,itrace,istop) + use psb_base_mod + use psb_prec_mod + use psb_d_inner_krylov_mod + use psb_krylov_mod + implicit none + type(psb_dspmat_type), intent(in) :: a + Type(psb_desc_type), Intent(in) :: desc_a + class(psb_dprec_type), intent(inout) :: prec + type(psb_d_vect_type), Intent(inout) :: b + type(psb_d_vect_type), Intent(inout) :: x + Real(psb_dpk_), Intent(in) :: eps + integer, intent(out) :: info + Integer, Optional, Intent(in) :: itmax, itrace,istop + Integer, Optional, Intent(out) :: iter + Real(psb_dpk_), Optional, Intent(out) :: err +!!$ local data + Real(psb_dpk_), allocatable, target :: aux(:) + type(psb_d_vect_type), allocatable, target :: wwrk(:) + type(psb_d_vect_type), pointer :: ww, q, r, p, v,& + & s, z, f, rt, qt, uv + Integer :: itmax_, naux, mglob, it, itrace_,int_err(5),& + & np,me, n_row, n_col,istop_, err_act + Integer :: itx, isvch, ictxt + integer :: debug_level, debug_unit + Real(psb_dpk_) :: alpha, beta, rho, rho_old, sigma + type(psb_itconv_type) :: stopdat + character(len=20) :: name + character(len=*), parameter :: methdname='CGS' + + info = psb_success_ + name = 'psb_dcgs' + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt = desc_a%get_context() + Call psb_info(ictxt, me, np) + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),': from psb_info',np + if (.not.allocated(b%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + mglob = desc_a%get_global_rows() + n_row = desc_a%get_local_rows() + n_col = desc_a%get_local_cols() + + If (Present(istop)) Then + istop_ = istop + Else + istop_ = 2 + Endif + + call psb_chkvect(mglob,1,x%get_nrows(),1,1,desc_a,info) + if (info == psb_success_) call psb_chkvect(mglob,1,b%get_nrows(),1,1,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_chkvect on X/B') + goto 9999 + end if + + naux=4*n_col + Allocate(aux(naux),stat=info) + if (info == psb_success_) Call psb_geall(wwrk,desc_a,info,n=11) + if (info == psb_success_) Call psb_geasb(wwrk,desc_a,info,mold=x%v) + if (info /= psb_success_) Then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + End If + + q => wwrk(1) + qt => wwrk(2) + r => wwrk(3) + rt => wwrk(4) + p => wwrk(5) + v => wwrk(6) + uv => wwrk(7) + z => wwrk(8) + f => wwrk(9) + s => wwrk(10) + ww => wwrk(11) + + + If (Present(itmax)) Then + itmax_ = itmax + Else + itmax_ = 1000 + Endif + + If (Present(itrace)) Then + itrace_ = itrace + Else + itrace_ = 0 + End If + + ! Ensure global coherence for convergence checks. + call psb_set_coher(ictxt,isvch) + + itx = 0 + + call psb_init_conv(methdname,istop_,itrace_,itmax_,a,b,eps,desc_a,stopdat,info) + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + restart: Do +!!$ +!!$ r0 = b-ax0 +!!$ + if (itx >= itmax_) exit restart + it = 0 + call psb_geaxpby(done,b,dzero,r,desc_a,info) + if (info == psb_success_) call psb_spmm(-done,a,x,done,r,desc_a,info,work=aux) + if (info == psb_success_) call psb_geaxpby(done,r,dzero,rt,desc_a,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + + ! Perhaps we already satisfy the convergence criterion... + if (psb_check_conv(methdname,itx,x,r,desc_a,stopdat,info)) exit restart + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + rho = dzero + + iteration: do + it = it + 1 + itx = itx + 1 + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),'iteration: ',itx + + rho_old = rho + rho = psb_gedot(rt,r,desc_a,info) + + if (rho == dzero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' iteration breakdown r',rho + exit iteration + endif + + if (it == 1) then + call psb_geaxpby(done,r,dzero,uv,desc_a,info) + if (info == psb_success_) call psb_geaxpby(done,r,dzero,p,desc_a,info) + else + beta = (rho/rho_old) + call psb_geaxpby(done,r,dzero,uv,desc_a,info) + if (info == psb_success_) call psb_geaxpby(beta,q,done,uv,desc_a,info) + if (info == psb_success_) call psb_geaxpby(done,q,beta,p,desc_a,info) + if (info == psb_success_) call psb_geaxpby(done,uv,beta,p,desc_a,info) + end if + + if (info == psb_success_) call prec%apply(p,f,desc_a,info,work=aux) + + if (info == psb_success_) call psb_spmm(done,a,f,dzero,v,desc_a,info,& + & work=aux) + + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='First loop part ') + goto 9999 + end if + + sigma = psb_gedot(rt,v,desc_a,info) + if (sigma == dzero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' iteration breakdown s1', sigma + exit iteration + endif + + alpha = rho/sigma + + if (info == psb_success_) call psb_geaxpby(done,uv,dzero,q,desc_a,info) + if (info == psb_success_) call psb_geaxpby(-alpha,v,done,q,desc_a,info) + if (info == psb_success_) call psb_geaxpby(done,uv,dzero,s,desc_a,info) + if (info == psb_success_) call psb_geaxpby(done,q,done,s,desc_a,info) + + if (info == psb_success_) call prec%apply(s,z,desc_a,info,work=aux) + + if (info == psb_success_) call psb_geaxpby(alpha,z,done,x,desc_a,info) + + if (info == psb_success_) call psb_spmm(done,a,z,dzero,qt,desc_a,info,& + & work=aux) + + if (info == psb_success_) call psb_geaxpby(-alpha,qt,done,r,desc_a,info) + + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='X update ') + goto 9999 + end if + + if (psb_check_conv(methdname,itx,x,r,desc_a,stopdat,info)) exit restart + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + end do iteration + end do restart + + call psb_end_conv(methdname,itx,desc_a,stopdat,info,err,iter) + + if (info == psb_success_) call psb_gefree(wwrk,desc_a,info) + if (info == psb_success_) deallocate(aux,stat=info) + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + + ! restore external global coherence behaviour + call psb_restore_coher(ictxt,isvch) + 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 psb_dcgs_vect diff --git a/krylov/psb_dcgstab.F90 b/krylov/psb_dcgstab.F90 index 38fd74833..558eb0d49 100644 --- a/krylov/psb_dcgstab.F90 +++ b/krylov/psb_dcgstab.F90 @@ -97,7 +97,7 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) use psb_base_mod use psb_prec_mod - use psb_inner_krylov_mod + use psb_d_inner_krylov_mod use psb_krylov_mod implicit none @@ -122,7 +122,7 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) Integer, Parameter :: irmax = 8 Integer :: itx, isvch, ictxt, err_act, i Integer :: istop_ - Real(psb_dpk_) :: alpha, beta, rho, rho_old, sigma, omega, tau + Real(psb_dpk_) :: alpha, beta, rho, rho_old, sigma, omega, tau type(psb_itconv_type) :: stopdat #ifdef MPE_KRYLOV @@ -194,6 +194,7 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) allocate(aux(naux),stat=info) if (info == psb_success_) call psb_geall(wwrk,desc_a,info,n=8) if (info == psb_success_) call psb_geasb(wwrk,desc_a,info) + if (info /= psb_success_) then info=psb_err_from_subroutine_non_ call psb_errpush(info,name) @@ -226,7 +227,7 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) itx = 0 call psb_init_conv(methdname,istop_,itrace_,itmax_,a,b,eps,desc_a,stopdat,info) - if (info /= psb_success_) Then + if (psb_errstatus_fatal()) Then call psb_errpush(psb_err_from_subroutine_non_,name) goto 9999 End If @@ -245,7 +246,7 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) imerr = MPE_Log_event( imme, 0, "ed SPMM" ) #endif if (info == psb_success_) call psb_geaxpby(done,r,dzero,q,desc_a,info) - if (info /= psb_success_) then + if (psb_errstatus_fatal()) then info=psb_err_from_subroutine_ call psb_errpush(info,name,a_err='Init residual') goto 9999 @@ -253,7 +254,7 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) ! Perhaps we already satisfy the convergence criterion... if (psb_check_conv(methdname,itx,x,r,desc_a,stopdat,info)) exit restart - if (info /= psb_success_) Then + if (psb_errstatus_fatal()) Then call psb_errpush(psb_err_from_subroutine_non_,name) goto 9999 End If @@ -271,6 +272,10 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) rho_old = rho rho = psb_gedot(q,r,desc_a,info) + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),& + & ' Rho: ',rho + if (rho == dzero) then if (debug_level >= psb_debug_ext_) & & write(debug_unit,*) me,' ',trim(name),& @@ -289,18 +294,27 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) #ifdef MPE_KRYLOV imerr = MPE_Log_event( ifctb, 0, "st PREC" ) #endif + if (debug_level >= psb_debug_inner_) write(0,*) 'P: ',p call prec%apply(p,f,desc_a,info,work=aux) + if (debug_level >= psb_debug_inner_) write(0,*) 'F: ',f #ifdef MPE_KRYLOV imerr = MPE_Log_event( ifcte, 0, "ed PREC" ) imerr = MPE_Log_event( immb, 0, "st SPMM" ) #endif call psb_spmm(done,a,f,dzero,v,desc_a,info,& & work=aux) + if (debug_level >= psb_debug_inner_) write(0,*) 'Q: ',q + if (debug_level >= psb_debug_inner_) write(0,*) 'V: ',v + #ifdef MPE_KRYLOV imerr = MPE_Log_event( imme, 0, "ed SPMM" ) #endif sigma = psb_gedot(q,v,desc_a,info) + + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),& + & ' Sigma: ',sigma if (sigma == dzero) then if (debug_level >= psb_debug_ext_) & & write(debug_unit,*) me,' ',trim(name),& @@ -311,8 +325,11 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) alpha = rho/sigma call psb_geaxpby(done,r,dzero,s,desc_a,info) if (info == psb_success_) call psb_geaxpby(-alpha,v,done,s,desc_a,info) + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),& + & ' alpha: ',alpha - if(info /= psb_success_) then + if(psb_errstatus_fatal()) then call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_geaxpby') goto 9999 end if @@ -332,7 +349,7 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) #ifdef MPE_KRYLOV imerr = MPE_Log_event( imme, 0, "ed SPMM" ) #endif - if(info /= psb_success_) then + if(psb_errstatus_fatal()) then call psb_errpush(psb_err_from_subroutine_,name,a_err='precaply/spmm') goto 9999 end if @@ -348,6 +365,10 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) tau = psb_gedot(t,s,desc_a,info) omega = tau/sigma + + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),& + & ' sigma, tau, omega: ',sigma, tau, omega if (omega == dzero) then if (debug_level >= psb_debug_ext_) & & write(debug_unit,*) me,' ',trim(name),& @@ -359,13 +380,13 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) if (info == psb_success_) call psb_geaxpby(omega,z,done,x,desc_a,info) if (info == psb_success_) call psb_geaxpby(done,s,dzero,r,desc_a,info) if (info == psb_success_) call psb_geaxpby(-omega,t,done,r,desc_a,info) - if (info /= psb_success_) Then + if (psb_errstatus_fatal()) Then call psb_errpush(psb_err_from_subroutine_,name,a_err='X/R update ') goto 9999 End If if (psb_check_conv(methdname,itx,x,r,desc_a,stopdat,info)) exit restart - if (info /= psb_success_) Then + if (psb_errstatus_fatal()) Then call psb_errpush(psb_err_from_subroutine_non_,name) goto 9999 End If @@ -376,8 +397,8 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) call psb_end_conv(methdname,itx,desc_a,stopdat,info,err,iter) deallocate(aux,stat=info) - if (info == psb_success_) call psb_gefree(wwrk,desc_a,info) - if(info /= psb_success_) then + call psb_gefree(wwrk,desc_a,info) + if((info /= 0).or.(psb_errstatus_fatal())) then call psb_errpush(info,name) goto 9999 end if @@ -402,3 +423,323 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) End Subroutine psb_dcgstab + +Subroutine psb_dcgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) + use psb_base_mod + use psb_prec_mod + use psb_d_inner_krylov_mod + use psb_krylov_mod + implicit none + type(psb_dspmat_type), intent(in) :: a + class(psb_dprec_type), Intent(inout) :: prec + Type(psb_desc_type), Intent(in) :: desc_a + type(psb_d_vect_type), Intent(inout) :: b + type(psb_d_vect_type), Intent(inout) :: x + Real(psb_dpk_), Intent(in) :: eps + integer, intent(out) :: info + Integer, Optional, Intent(in) :: itmax, itrace, istop + Integer, Optional, Intent(out) :: iter + Real(psb_dpk_), Optional, Intent(out) :: err +!!$ Local data + Real(psb_dpk_), allocatable, target :: aux(:),wwrk(:,:) +!!$ Real(psb_dpk_), Pointer :: q(:),& +!!$ & r(:), p(:), v(:), s(:), t(:), z(:), f(:) + type(psb_d_vect_type) :: q, r, p, v, s, t, z, f + + Integer :: itmax_, naux, mglob, it,itrace_,& + & np,me, n_row, n_col + integer :: debug_level, debug_unit + Logical, Parameter :: exchange=.True., noexchange=.False., debug1 = .False. + Integer, Parameter :: irmax = 8 + Integer :: itx, isvch, ictxt, err_act, i + Integer :: istop_ + Real(psb_dpk_) :: alpha, beta, rho, rho_old, sigma, omega, tau + type(psb_itconv_type) :: stopdat + real(psb_dpk_), external :: ddot + + character(len=20) :: name + character(len=*), parameter :: methdname='BiCGStab' + + info = psb_success_ + name = 'psb_dcgstab' + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + ictxt = desc_a%get_context() + call psb_info(ictxt, me, np) + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),': from psb_info',np + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(b%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + mglob = desc_a%get_global_rows() + n_row = desc_a%get_local_rows() + n_col = desc_a%get_local_cols() + + If (Present(istop)) Then + istop_ = istop + Else + istop_ = 2 + Endif + ! + ! ISTOP_ = 1: Normwise backward error, infinity norm + ! ISTOP_ = 2: ||r||/||b|| norm 2 + ! +!!$ if (.not.same_type_as(x,b)) then +!!$ write(0,*) 'Warning: different dynamic types for X and B ' +!!$ end if + + call psb_chkvect(mglob,1,x%get_nrows(),1,1,desc_a,info) + if (psb_errstatus_fatal()) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_chkvect on X') + goto 9999 + end if + call psb_chkvect(mglob,1,b%get_nrows(),1,1,desc_a,info) + if (psb_errstatus_fatal()) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_chkvect on B') + goto 9999 + end if + naux=6*n_col + if (info == psb_success_) allocate(aux(naux),stat=info) + if (info /= psb_success_) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + End If + + + call psb_geall(q,desc_a,info) + call psb_geall(r,desc_a,info) + call psb_geall(p,desc_a,info) + call psb_geall(v,desc_a,info) + call psb_geall(s,desc_a,info) + call psb_geall(t,desc_a,info) + call psb_geall(z,desc_a,info) + call psb_geall(f,desc_a,info) + + call psb_geasb(q,desc_a,info,mold=x%v) + call psb_geasb(r,desc_a,info,mold=x%v) + call psb_geasb(p,desc_a,info,mold=x%v) + call psb_geasb(v,desc_a,info,mold=x%v) + call psb_geasb(s,desc_a,info,mold=x%v) + call psb_geasb(t,desc_a,info,mold=x%v) + call psb_geasb(z,desc_a,info,mold=x%v) + call psb_geasb(f,desc_a,info,mold=x%v) + + + if (psb_errstatus_fatal()) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + End If + + If (Present(itmax)) Then + itmax_ = itmax + Else + itmax_ = 1000 + Endif + + If (Present(itrace)) Then + itrace_ = itrace + Else + itrace_ = 0 + End If + + ! Ensure global coherence for convergence checks. + call psb_set_coher(ictxt,isvch) + + itx = 0 + call psb_init_conv(methdname,istop_,itrace_,itmax_,a,b,eps,desc_a,stopdat,info) + if (psb_errstatus_fatal()) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + restart: Do + + if (itx >= itmax_) exit restart + + it = 0 + call psb_geaxpby(done,b,dzero,r,desc_a,info) + + call psb_spmm(-done,a,x,done,r,desc_a,info,work=aux) + call psb_geaxpby(done,r,dzero,q,desc_a,info) + + ! Perhaps we already satisfy the convergence criterion... + if (psb_check_conv(methdname,itx,x,r,desc_a,stopdat,info)) exit restart + + if (psb_errstatus_fatal()) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='Init residual chk') + goto 9999 + end if + + + rho = dzero + + iteration: Do + it = it + 1 + itx = itx + 1 + + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),& + & ' Iteration: ',itx + + rho_old = rho + rho = psb_gedot(q,r,desc_a,info) + + if (debug_level >= psb_debug_ext_) then + call q%sync() + call r%sync() + end if + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),& + & ' Rho: ',rho, ddot(n_row,q%v,1,r%v,1) + + if (rho == dzero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' Iteration breakdown R',rho + exit iteration + endif + + if (it == 1) then + call psb_geaxpby(done,r,dzero,p,desc_a,info) + else + beta = (rho/rho_old)*(alpha/omega) + call psb_geaxpby(-omega,v,done,p,desc_a,info) + call psb_geaxpby(done,r,beta,p,desc_a,info) + End If + + call prec%apply(p,f,desc_a,info,work=aux) + + call psb_spmm(done,a,f,dzero,v,desc_a,info,& + & work=aux) + + + sigma = psb_gedot(q,v,desc_a,info) + + if (debug_level >= psb_debug_ext_) then + call q%sync() + call v%sync() + end if + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),& + & ' Sigma: ',sigma, ddot(n_row,q%v,1,v%v,1) + + + if (sigma == dzero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' Iteration breakdown S1', sigma + exit iteration + endif + + alpha = rho/sigma + call psb_geaxpby(done,r,dzero,s,desc_a,info) + call psb_geaxpby(-alpha,v,done,s,desc_a,info) + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),& + & ' alpha: ',alpha + + + if (psb_errstatus_fatal()) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_geaxpby') + goto 9999 + end if + + + call prec%apply(s,z,desc_a,info,work=aux) + Call psb_spmm(done,a,z,dzero,t,desc_a,info,work=aux) + + if(psb_errstatus_fatal()) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='precaply/spmm') + goto 9999 + end if + + sigma = psb_gedot(t,t,desc_a,info) + if (sigma == dzero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' Iteration breakdown S2', sigma + exit iteration + endif + + tau = psb_gedot(t,s,desc_a,info) + omega = tau/sigma + + if (debug_level >= psb_debug_ext_) then + call t%sync() + call s%sync() + end if + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),& + & ' sigma, tau, omega: ',sigma, tau, omega& + &, ddot(n_row,t%v,1,t%v,1), ddot(n_row,t%v,1,s%v,1) + + + if (omega == dzero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' Iteration breakdown O',omega + exit iteration + endif + + call psb_geaxpby(alpha,f,done,x,desc_a,info) + call psb_geaxpby(omega,z,done,x,desc_a,info) + call psb_geaxpby(done,s,dzero,r,desc_a,info) + call psb_geaxpby(-omega,t,done,r,desc_a,info) + if (psb_check_conv(methdname,itx,x,r,desc_a,stopdat,info)) exit restart + + if (psb_errstatus_fatal()) Then + call psb_errpush(psb_err_from_subroutine_,name,a_err='X/R update ') + goto 9999 + End If + + end do iteration + end do restart + + call psb_end_conv(methdname,itx,desc_a,stopdat,info,err,iter) + + deallocate(aux,stat=info) + + call x%sync() + call psb_gefree(q,desc_a,info) + call psb_gefree(r,desc_a,info) + call psb_gefree(p,desc_a,info) + call psb_gefree(v,desc_a,info) + call psb_gefree(s,desc_a,info) + call psb_gefree(t,desc_a,info) + call psb_gefree(z,desc_a,info) + call psb_gefree(f,desc_a,info) + + if(psb_errstatus_fatal()) then + call psb_errpush(info,name) + goto 9999 + end if + ! restore external global coherence behaviour + call psb_restore_coher(ictxt,isvch) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +End Subroutine psb_dcgstab_vect + diff --git a/krylov/psb_dcgstabl.f90 b/krylov/psb_dcgstabl.f90 index 7b8655b20..a2ad1819e 100644 --- a/krylov/psb_dcgstabl.f90 +++ b/krylov/psb_dcgstabl.f90 @@ -106,7 +106,7 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,istop) use psb_base_mod use psb_prec_mod - use psb_inner_krylov_mod + use psb_d_inner_krylov_mod use psb_krylov_mod implicit none type(psb_dspmat_type), intent(in) :: a @@ -122,9 +122,10 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,is Integer, Optional, Intent(out) :: iter Real(psb_dpk_), Optional, Intent(out) :: err !!$ local data - Real(psb_dpk_), allocatable, target :: aux(:),wwrk(:,:),uh(:,:), rh(:,:) + Real(psb_dpk_), allocatable, target :: aux(:),wwrk(:,:),uh(:,:), rh(:,:),& + & gamma(:), gamma1(:), gamma2(:), taum(:,:), sigma(:) Real(psb_dpk_), Pointer :: ww(:), q(:), r(:), rt0(:), p(:), v(:), & - & s(:), t(:), z(:), f(:), gamma(:), gamma1(:), gamma2(:), taum(:,:), sigma(:) + & s(:), t(:), z(:), f(:) Integer :: itmax_, naux, mglob, it, itrace_,& & np,me, n_row, n_col, nl, err_act @@ -208,7 +209,7 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,is call psb_errpush(info,name) goto 9999 end if - if (info == psb_success_) Call psb_geall(wwrk,desc_a,info,n=psb_err_iarg_neg_) + if (info == psb_success_) Call psb_geall(wwrk,desc_a,info,n=10) if (info == psb_success_) Call psb_geall(uh,desc_a,info,n=nl+1,lb=0) if (info == psb_success_) Call psb_geall(rh,desc_a,info,n=nl+1,lb=0) if (info == psb_success_) Call psb_geasb(wwrk,desc_a,info) @@ -406,4 +407,324 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,is End Subroutine psb_dcgstabl +Subroutine psb_dcgstabl_vect(a,prec,b,x,eps,desc_a,info,& + & itmax,iter,err,itrace,irst,istop) + use psb_base_mod + use psb_prec_mod + use psb_d_inner_krylov_mod + use psb_krylov_mod + implicit none + type(psb_dspmat_type), intent(in) :: a + class(psb_dprec_type), Intent(inout) :: prec + Type(psb_desc_type), Intent(in) :: desc_a + type(psb_d_vect_type), Intent(inout) :: b + type(psb_d_vect_type), Intent(inout) :: x + Real(psb_dpk_), Intent(in) :: eps + integer, intent(out) :: info + Integer, Optional, Intent(in) :: itmax, itrace, irst,istop + Integer, Optional, Intent(out) :: iter + Real(psb_dpk_), Optional, Intent(out) :: err +!!$ local data + Real(psb_dpk_), allocatable, target :: aux(:), gamma(:),& + & gamma1(:), gamma2(:), taum(:,:), sigma(:) + type(psb_d_vect_type), allocatable, target :: wwrk(:),uh(:), rh(:) + type(psb_d_vect_type), Pointer :: ww, q, r, rt0, p, v, & + & s, t, z, f + + Integer :: itmax_, naux, mglob, it, itrace_,& + & np,me, n_row, n_col, nl, err_act + Logical, Parameter :: exchange=.True., noexchange=.False. + Integer, Parameter :: irmax = 8 + Integer :: itx, i, isvch, ictxt,istop_,j, k, int_err(5) + integer :: debug_level, debug_unit + Real(psb_dpk_) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,& + & omega + type(psb_itconv_type) :: stopdat + character(len=20) :: name + character(len=*), parameter :: methdname='BiCGStab(L)' + + info = psb_success_ + name = 'psb_dcgstabl' + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt = desc_a%get_context() + Call psb_info(ictxt, me, np) + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),': from psb_info',np + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(b%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + mglob = desc_a%get_global_rows() + n_row = desc_a%get_local_rows() + n_col = desc_a%get_local_cols() + + if (present(istop)) then + istop_ = istop + else + istop_ = 2 + endif + + if (present(itmax)) then + itmax_ = itmax + else + itmax_ = 1000 + endif + + if (present(itrace)) then + itrace_ = itrace + else + itrace_ = 0 + end if + + if (present(irst)) then + nl = irst + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & 'present: irst: ',irst,nl + else + nl = 1 + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' not present: irst: ',irst,nl + endif + if (nl <=0 ) then + info=psb_err_invalid_istop_ + int_err(1)=nl + err=info + call psb_errpush(info,name,i_err=int_err) + goto 9999 + endif + + call psb_chkvect(mglob,1,x%get_nrows(),1,1,desc_a,info) + if (info == psb_success_) call psb_chkvect(mglob,1,b%get_nrows(),1,1,desc_a,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_chkvect on X/B') + goto 9999 + end if + + naux=4*n_col + allocate(aux(naux),gamma(0:nl),gamma1(nl),& + &gamma2(nl),taum(nl,nl),sigma(nl), stat=info) + + if (info /= psb_success_) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + end if + if (info == psb_success_) Call psb_geall(wwrk,desc_a,info,n=10) + if (info == psb_success_) Call psb_geall(uh,desc_a,info,n=nl+1,lb=0) + if (info == psb_success_) Call psb_geall(rh,desc_a,info,n=nl+1,lb=0) + if (info == psb_success_) Call psb_geasb(wwrk,desc_a,info,mold=x%v) + if (info == psb_success_) Call psb_geasb(uh,desc_a,info,mold=x%v) + if (info == psb_success_) Call psb_geasb(rh,desc_a,info,mold=x%v) + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + q => wwrk(1) + r => wwrk(2) + p => wwrk(3) + v => wwrk(4) + f => wwrk(5) + s => wwrk(6) + t => wwrk(7) + z => wwrk(8) + ww => wwrk(9) + rt0 => wwrk(10) + + ! Ensure global coherence for convergence checks. + call psb_set_coher(ictxt,isvch) + + + call psb_init_conv(methdname,istop_,itrace_,itmax_,a,b,eps,desc_a,stopdat,info) + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + itx = 0 + restart: do +!!$ +!!$ r0 = b-ax0 +!!$ + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),' restart: ',itx,it + if (itx >= itmax_) exit restart + + it = 0 + call psb_geaxpby(done,b,dzero,r,desc_a,info) + if (info == psb_success_) call psb_spmm(-done,a,x,done,r,desc_a,info,work=aux) + + if (info == psb_success_) call prec%apply(r,desc_a,info) + + if (info == psb_success_) call psb_geaxpby(done,r,dzero,rt0,desc_a,info) + if (info == psb_success_) call psb_geaxpby(done,r,dzero,rh(0),desc_a,info) + if (info == psb_success_) call psb_geaxpby(dzero,r,dzero,uh(0),desc_a,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + rho = done + alpha = dzero + omega = done + + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' on entry to amax: b: ',b%get_nrows() + + if (psb_check_conv(methdname,itx,x,r,desc_a,stopdat,info)) exit restart + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + iteration: do + it = it + nl + itx = itx + nl + rho = -omega*rho + + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' iteration: ',itx, rho + + do j = 0, nl -1 + If (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),'bicg part: ',j, nl + + rho_old = rho + rho = psb_gedot(rh(j),rt0,desc_a,info) + if (rho == dzero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' bi-cgstab iteration breakdown r',rho + exit iteration + endif + + beta = alpha*rho/rho_old + rho_old = rho + do k=0, j +!!$ call psb_geaxpby(done,rh(:,0:j),-beta,uh(:,0:j),desc_a,info) + call psb_geaxpby(done,rh(k),-beta,uh(k),desc_a,info) + end do + call psb_spmm(done,a,uh(j),dzero,uh(j+1),desc_a,info,work=aux) + + call prec%apply(uh(j+1),desc_a,info) + + gamma(j) = psb_gedot(uh(j+1),rt0,desc_a,info) + + if (gamma(j) == dzero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' bi-cgstab iteration breakdown s2',gamma(j) + exit iteration + endif + alpha = rho/gamma(j) + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' bicg part: alpha=r/g ',alpha,rho,gamma(j) + + do k=0,j +!!$ call psb_geaxpby(-alpha,uh(:,1:j+1),done,rh(:,0:j),desc_a,info) + call psb_geaxpby(-alpha,uh(k+1),done,rh(k),desc_a,info) + end do + call psb_geaxpby(alpha,uh(0),done,x,desc_a,info) + call psb_spmm(done,a,rh(j),dzero,rh(j+1),desc_a,info,work=aux) + + call prec%apply(rh(j+1),desc_a,info) + + enddo + + do j=1, nl + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' mod g-s part: ',j, nl + + do i=1, j-1 + taum(i,j) = psb_gedot(rh(i),rh(j),desc_a,info) + taum(i,j) = taum(i,j)/sigma(i) + call psb_geaxpby(-taum(i,j),rh(i),done,rh(j),desc_a,info) + enddo + sigma(j) = psb_gedot(rh(j),rh(j),desc_a,info) + gamma1(j) = psb_gedot(rh(0),rh(j),desc_a,info) + gamma1(j) = gamma1(j)/sigma(j) + enddo + + gamma(nl) = gamma1(nl) + omega = gamma(nl) + + do j=nl-1,1,-1 + gamma(j) = gamma1(j) + do i=j+1,nl + gamma(j) = gamma(j) - taum(j,i) * gamma(i) + enddo + enddo + + do j=1,nl-1 + gamma2(j) = gamma(j+1) + do i=j+1,nl-1 + gamma2(j) = gamma2(j) + taum(j,i) * gamma(i+1) + enddo + enddo + + call psb_geaxpby(gamma(1),rh(0),done,x,desc_a,info) + call psb_geaxpby(-gamma1(nl),rh(nl),done,rh(0),desc_a,info) + call psb_geaxpby(-gamma(nl),uh(nl),done,uh(0),desc_a,info) + + do j=1, nl-1 + call psb_geaxpby(-gamma(j),uh(j),done,uh(0),desc_a,info) + call psb_geaxpby(gamma2(j),rh(j),done,x,desc_a,info) + call psb_geaxpby(-gamma1(j),rh(j),done,rh(0),desc_a,info) + enddo + + if (psb_check_conv(methdname,itx,x,rh(0),desc_a,stopdat,info)) exit restart + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + end do iteration + end do restart + + call psb_end_conv(methdname,itx,desc_a,stopdat,info,err,iter) + + if (info == psb_success_) call psb_gefree(uh,desc_a,info) + if (info == psb_success_) call psb_gefree(rh,desc_a,info) + if (info == psb_success_) call psb_gefree(wwrk,desc_a,info) + if (info == psb_success_) deallocate(aux,stat=info) + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + + ! restore external global coherence behaviour + call psb_restore_coher(ictxt,isvch) + 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 psb_dcgstabl_vect + diff --git a/krylov/psb_dkrylov.f90 b/krylov/psb_dkrylov.f90 index ad34a1860..25ef69a2b 100644 --- a/krylov/psb_dkrylov.f90 +++ b/krylov/psb_dkrylov.f90 @@ -77,7 +77,8 @@ ! estimate of) residual ! -Subroutine psb_dkrylov(method,a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,istop,cond) +Subroutine psb_dkrylov(method,a,prec,b,x,eps,desc_a,info,& + & itmax,iter,err,itrace,irst,istop,cond) use psb_base_mod use psb_prec_mod,only : psb_sprec_type, psb_dprec_type, psb_cprec_type, psb_zprec_type @@ -242,3 +243,176 @@ Subroutine psb_dkrylov(method,a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,i end subroutine psb_dkrylov +Subroutine psb_dkrylov_vect(method,a,prec,b,x,eps,desc_a,info,& + & itmax,iter,err,itrace,irst,istop,cond) + + use psb_base_mod + use psb_prec_mod,only : psb_sprec_type, psb_dprec_type,& + & psb_cprec_type, psb_zprec_type + use psb_krylov_mod, psb_protect_name => psb_dkrylov_vect + + character(len=*) :: method + Type(psb_dspmat_type), Intent(in) :: a + Type(psb_desc_type), Intent(in) :: desc_a + class(psb_dprec_type), intent(inout) :: prec + type(psb_d_vect_type), Intent(inout) :: b + type(psb_d_vect_type), Intent(inout) :: x + Real(psb_dpk_), Intent(in) :: eps + integer, intent(out) :: info + Integer, Optional, Intent(in) :: itmax, itrace, irst,istop + Integer, Optional, Intent(out) :: iter + Real(psb_dpk_), Optional, Intent(out) :: err,cond + + interface + subroutine psb_dcg_vect(a,prec,b,x,eps,& + & desc_a,info,itmax,iter,err,itrace,istop,cond) + use psb_base_mod, only : psb_desc_type, psb_dspmat_type,& + & psb_dpk_, psb_d_vect_type + use psb_prec_mod, only : psb_dprec_type + type(psb_dspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + class(psb_dprec_type), intent(inout) :: prec + type(psb_d_vect_type), Intent(inout) :: b + type(psb_d_vect_type), Intent(inout) :: x + real(psb_dpk_), intent(in) :: eps + integer, intent(out) :: info + integer, optional, intent(in) :: itmax, itrace,istop + integer, optional, intent(out) :: iter + real(psb_dpk_), optional, intent(out) :: err,cond + end subroutine psb_dcg_vect + subroutine psb_dbicg_vect(a,prec,b,x,eps,& + & desc_a,info,itmax,iter,err,itrace,istop) + use psb_base_mod, only : psb_desc_type, psb_dspmat_type,& + & psb_dpk_, psb_d_vect_type + use psb_prec_mod, only : psb_dprec_type + type(psb_dspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + class(psb_dprec_type), intent(inout) :: prec + type(psb_d_vect_type), Intent(inout) :: b + type(psb_d_vect_type), Intent(inout) :: x + real(psb_dpk_), intent(in) :: eps + integer, intent(out) :: info + integer, optional, intent(in) :: itmax, itrace,istop + integer, optional, intent(out) :: iter + real(psb_dpk_), optional, intent(out) :: err + end subroutine psb_dbicg_vect + subroutine psb_dcgstab_vect(a,prec,b,x,eps,& + & desc_a,info,itmax,iter,err,itrace,istop) + use psb_base_mod, only : psb_desc_type, psb_dspmat_type,& + & psb_dpk_, psb_d_vect_type + use psb_prec_mod, only : psb_dprec_type + type(psb_dspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + type(psb_d_vect_type), Intent(inout) :: b + type(psb_d_vect_type), Intent(inout) :: x + real(psb_dpk_), intent(in) :: eps + class(psb_dprec_type), intent(inout) :: prec + integer, intent(out) :: info + integer, optional, intent(in) :: itmax, itrace,istop + integer, optional, intent(out) :: iter + real(psb_dpk_), optional, intent(out) :: err + end subroutine psb_dcgstab_vect + Subroutine psb_dcgstabl_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err, itrace,irst,istop) + use psb_base_mod, only : psb_desc_type, psb_dspmat_type, & + & psb_dpk_, psb_d_vect_type + use psb_prec_mod, only : psb_dprec_type + Type(psb_dspmat_type), Intent(in) :: a + Type(psb_desc_type), Intent(in) :: desc_a + class(psb_dprec_type), intent(inout) :: prec + type(psb_d_vect_type), Intent(inout) :: b + type(psb_d_vect_type), Intent(inout) :: x + Real(psb_dpk_), Intent(in) :: eps + integer, intent(out) :: info + Integer, Optional, Intent(in) :: itmax, itrace, irst,istop + Integer, Optional, Intent(out) :: iter + Real(psb_dpk_), Optional, Intent(out) :: err + end subroutine psb_dcgstabl_vect + Subroutine psb_drgmres_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err,itrace,irst,istop) + use psb_base_mod, only : psb_desc_type, psb_dspmat_type,& + & psb_dpk_, psb_d_vect_type + use psb_prec_mod, only : psb_dprec_type + Type(psb_dspmat_type), Intent(in) :: a + Type(psb_desc_type), Intent(in) :: desc_a + class(psb_dprec_type), intent(inout) :: prec + type(psb_d_vect_type), Intent(inout) :: b + type(psb_d_vect_type), Intent(inout) :: x + Real(psb_dpk_), Intent(in) :: eps + integer, intent(out) :: info + Integer, Optional, Intent(in) :: itmax, itrace, irst,istop + Integer, Optional, Intent(out) :: iter + Real(psb_dpk_), Optional, Intent(out) :: err + end subroutine psb_drgmres_vect + subroutine psb_dcgs_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err,itrace,istop) + use psb_base_mod, only : psb_desc_type, psb_dspmat_type,& + & psb_dpk_, psb_d_vect_type + use psb_prec_mod, only : psb_dprec_type + type(psb_dspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + class(psb_dprec_type), intent(inout) :: prec + type(psb_d_vect_type), Intent(inout) :: b + type(psb_d_vect_type), Intent(inout) :: x + real(psb_dpk_), intent(in) :: eps + integer, intent(out) :: info + integer, optional, intent(in) :: itmax, itrace,istop + integer, optional, intent(out) :: iter + real(psb_dpk_), optional, intent(out) :: err + end subroutine psb_dcgs_vect + end interface + integer :: ictxt,me,np,err_act + character(len=20) :: name + + info = psb_success_ + name = 'psb_krylov' + call psb_erractionsave(err_act) + + ictxt=desc_a%get_context() + + call psb_info(ictxt, me, np) + + select case(psb_toupper(method)) + case('CG') + call psb_dcg_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err,itrace,istop,cond) + case('CGS') + call psb_dcgs_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err,itrace,istop) + case('BICG') + call psb_dbicg_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err,itrace,istop) + case('BICGSTAB') + call psb_dcgstab_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err,itrace,istop) + case('RGMRES') + call psb_drgmres_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err,itrace,irst,istop) + case('BICGSTABL') + call psb_dcgstabl_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err,itrace,irst,istop) + case default + if (me == 0) write(psb_err_unit,*) trim(name),& + & ': Warning: Unknown method ',method,& + & ', defaulting to BiCGSTAB' + call psb_dcgstab_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err,itrace,istop) + end select + + if(info /= psb_success_) 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(ictxt) + return + end if + +end subroutine psb_dkrylov_vect + diff --git a/krylov/psb_drgmres.f90 b/krylov/psb_drgmres.f90 index cb2ab6071..7901d9a31 100644 --- a/krylov/psb_drgmres.f90 +++ b/krylov/psb_drgmres.f90 @@ -109,7 +109,7 @@ subroutine psb_drgmres(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,istop) use psb_base_mod use psb_prec_mod - use psb_inner_krylov_mod + use psb_d_inner_krylov_mod use psb_krylov_mod implicit none type(psb_dspmat_type), intent(in) :: a @@ -467,3 +467,377 @@ subroutine psb_drgmres(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,ist end subroutine psb_drgmres +subroutine psb_drgmres_vect(a,prec,b,x,eps,desc_a,info,& + & itmax,iter,err,itrace,irst,istop) + use psb_base_mod + use psb_prec_mod + use psb_d_inner_krylov_mod + use psb_krylov_mod + implicit none + type(psb_dspmat_type), intent(in) :: a + Type(psb_desc_type), Intent(in) :: desc_a + class(psb_dprec_type), intent(inout) :: prec + type(psb_d_vect_type), Intent(inout) :: b + type(psb_d_vect_type), Intent(inout) :: x + Real(psb_dpk_), Intent(in) :: eps + integer, intent(out) :: info + Integer, Optional, Intent(in) :: itmax, itrace, irst,istop + Integer, Optional, Intent(out) :: iter + Real(psb_dpk_), Optional, Intent(out) :: err +!!$ local data + Real(psb_dpk_), allocatable :: aux(:) + Real(psb_dpk_), allocatable :: c(:), s(:), h(:,:), rs(:), rst(:) + type(psb_d_vect_type), allocatable :: v(:) + type(psb_d_vect_type) :: w, w1, xt + Real(psb_dpk_) :: scal, gm, rti, rti1 + Integer ::litmax, naux, mglob, it,k, itrace_,& + & np,me, n_row, n_col, nl, int_err(5) + Logical, Parameter :: exchange=.True., noexchange=.False., use_drot=.true. + Integer, Parameter :: irmax = 8 + Integer :: itx, i, isvch, ictxt,istop_, err_act + integer :: debug_level, debug_unit + Real(psb_dpk_) :: rni, xni, bni, ani,bn2, dt + real(psb_dpk_), external :: dnrm2 + real(psb_dpk_) :: errnum, errden + character(len=20) :: name + character(len=*), parameter :: methdname='RGMRES' + + info = psb_success_ + name = 'psb_dgmres' + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt = desc_a%get_context() + Call psb_info(ictxt, me, np) + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),': from psb_info',np + if (.not.allocated(b%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + mglob = desc_a%get_global_rows() + n_row = desc_a%get_local_rows() + n_col = desc_a%get_local_cols() + + if (present(istop)) then + istop_ = istop + else + istop_ = 2 + endif +! +! ISTOP_ = 1: Normwise backward error, infinity norm +! ISTOP_ = 2: ||r||/||b||, 2-norm +! + + if ((istop_ < 1 ).or.(istop_ > 2 ) ) then + info=psb_err_invalid_istop_ + int_err(1)=istop_ + err=info + call psb_errpush(info,name,i_err=int_err) + goto 9999 + endif + + if (present(itmax)) then + litmax = itmax + else + litmax = 1000 + endif + + if (present(itrace)) then + itrace_ = itrace + else + itrace_ = 0 + end if + + if (present(irst)) then + nl = irst + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' present: irst: ',irst,nl + else + nl = 10 + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' not present: irst: ',irst,nl + endif + if (nl <=0 ) then + info=psb_err_invalid_istop_ + int_err(1)=nl + err=info + call psb_errpush(info,name,i_err=int_err) + goto 9999 + endif + + call psb_chkvect(mglob,1,x%get_nrows(),1,1,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_chkvect on X') + goto 9999 + end if + call psb_chkvect(mglob,1,b%get_nrows(),1,1,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_chkvect on B') + goto 9999 + end if + + + naux=4*n_col + allocate(aux(naux),h(nl+1,nl+1),& + &c(nl+1),s(nl+1),rs(nl+1), rst(nl+1),stat=info) + + if (info == psb_success_) call psb_geall(v,desc_a,info,n=nl+1) + if (info == psb_success_) call psb_geall(w,desc_a,info) + if (info == psb_success_) call psb_geall(w1,desc_a,info) + if (info == psb_success_) call psb_geall(xt,desc_a,info) + if (info == psb_success_) call psb_geasb(v,desc_a,info,mold=x%v) + if (info == psb_success_) call psb_geasb(w,desc_a,info,mold=x%v) + if (info == psb_success_) call psb_geasb(w1,desc_a,info,mold=x%v) + if (info == psb_success_) call psb_geasb(xt,desc_a,info,mold=x%v) + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' Size of V,W,W1 ',v(1)%get_nrows(),size(v),& + & w%get_nrows(),w1%get_nrows() + + ! Ensure global coherence for convergence checks. + call psb_set_coher(ictxt,isvch) + + if (istop_ == 1) then + ani = psb_spnrmi(a,desc_a,info) + bni = psb_geamax(b,desc_a,info) + else if (istop_ == 2) then + bn2 = psb_genrm2(b,desc_a,info) + endif + errnum = dzero + errden = done + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + if ((itrace_ > 0).and.(me == 0)) call log_header(methdname) + + itx = 0 + restart: do + + ! compute r0 = b-ax0 + ! check convergence + ! compute v1 = r0/||r0||_2 + + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' restart: ',itx,it + it = 0 + call psb_geaxpby(done,b,dzero,v(1),desc_a,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + call psb_spmm(-done,a,x,done,v(1),desc_a,info,work=aux) + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + rs(1) = psb_genrm2(v(1),desc_a,info) + rs(2:) = dzero + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + scal=done/rs(1) ! rs(1) MIGHT BE VERY SMALL - USE DSCAL TO DEAL WITH IT? + + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' on entry to amax: b: ',b%get_nrows(),rs(1),scal + + ! + ! check convergence + ! + if (istop_ == 1) then + rni = psb_geamax(v(1),desc_a,info) + xni = psb_geamax(x,desc_a,info) + errnum = rni + errden = (ani*xni+bni) + else if (istop_ == 2) then + rni = psb_genrm2(v(1),desc_a,info) + errnum = rni + errden = bn2 + endif + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + if (errnum <= eps*errden) exit restart + + if (itrace_ > 0) & + & call log_conv(methdname,me,itx,itrace_,errnum,errden,eps) + + call v(1)%scal(scal) !v(1) = v(1) * scal + + if (itx >= litmax) exit restart + + ! + ! inner iterations + ! + + inner: Do i=1,nl + itx = itx + 1 + + call prec%apply(v(i),w1,desc_a,info) + call psb_spmm(done,a,w1,dzero,w,desc_a,info,work=aux) + ! + + do k = 1, i + h(k,i) = psb_gedot(v(k),w,desc_a,info) + call psb_geaxpby(-h(k,i),v(k),done,w,desc_a,info) + end do + h(i+1,i) = psb_genrm2(w,desc_a,info) + scal=done/h(i+1,i) + call psb_geaxpby(scal,w,dzero,v(i+1),desc_a,info) + do k=2,i + call drot(1,h(k-1,i),1,h(k,i),1,c(k-1),s(k-1)) + enddo + + rti = h(i,i) + rti1 = h(i+1,i) + call drotg(rti,rti1,c(i),s(i)) + call drot(1,h(i,i),1,h(i+1,i),1,c(i),s(i)) + h(i+1,i) = dzero + call drot(1,rs(i),1,rs(i+1),1,c(i),s(i)) + + if (istop_ == 1) then + ! + ! build x and then compute the residual and its infinity norm + ! + rst = rs + call w1%set(dzero) + call dtrsm('l','u','n','n',i,1,done,h,size(h,1),rst,size(rst,1)) + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' Rebuild x-> RS:',rst(1:nl) + do k=1, i + call psb_geaxpby(rst(k),v(k),done,xt,desc_a,info) + end do + call prec%apply(xt,desc_a,info) + call psb_geaxpby(done,x,done,xt,desc_a,info) + call psb_geaxpby(done,b,dzero,w1,desc_a,info) + call psb_spmm(-done,a,xt,done,w1,desc_a,info,work=aux) + rni = psb_geamax(w1,desc_a,info) + xni = psb_geamax(xt,desc_a,info) + errnum = rni + errden = (ani*xni+bni) + ! + + else if (istop_ == 2) then + ! + ! compute the residual 2-norm as byproduct of the solution + ! procedure of the least-squares problem + ! + rni = abs(rs(i+1)) + errnum = rni + errden = bn2 + endif + + if (errnum <= eps*errden) then + + if (istop_ == 1) then + call psb_geaxpby(done,xt,dzero,x,desc_a,info) +!!$ x = xt + else if (istop_ == 2) then + ! + ! build x + ! + call dtrsm('l','u','n','n',i,1,done,h,size(h,1),rs,size(rs,1)) + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' Rebuild x-> RS:',rs(1:nl) + call w1%set(dzero) + do k=1, i + call psb_geaxpby(rs(k),v(k),done,w1,desc_a,info) + end do + call prec%apply(w1,w,desc_a,info) + call psb_geaxpby(done,w,done,x,desc_a,info) + end if + + exit restart + + end if + + if (itrace_ > 0) & + & call log_conv(methdname,me,itx,itrace_,errnum,errden,eps) + + end do inner + + if (istop_ == 1) then + call psb_geaxpby(done,xt,dzero,x,desc_a,info)! x = xt + else if (istop_ == 2) then + ! + ! build x + ! + call dtrsm('l','u','n','n',nl,1,done,h,size(h,1),rs,size(rs,1)) + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' Rebuild x-> RS:',rs(1:nl) + call w1%set(dzero) + do k=1, nl + call psb_geaxpby(rs(k),v(k),done,w1,desc_a,info) + end do + call prec%apply(w1,w,desc_a,info) + call psb_geaxpby(done,w,done,x,desc_a,info) + end if + + end do restart + if (itrace_ > 0) & + & call log_conv(methdname,me,itx,1,errnum,errden,eps) + + call log_end(methdname,me,itx,errnum,errden,eps,err=err,iter=iter) + + + if (info == psb_success_) call psb_gefree(v,desc_a,info) + if (info == psb_success_) call psb_gefree(w,desc_a,info) + if (info == psb_success_) call psb_gefree(w1,desc_a,info) + if (info == psb_success_) call psb_gefree(xt,desc_a,info) + if (info == psb_success_) deallocate(aux,h,c,s,rs,rst, stat=info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + ! restore external global coherence behaviour + call psb_restore_coher(ictxt,isvch) + + 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 psb_drgmres_vect + + diff --git a/krylov/psb_krylov_mod.f90 b/krylov/psb_krylov_mod.f90 index 79f6a0fc7..20ace1bc1 100644 --- a/krylov/psb_krylov_mod.f90 +++ b/krylov/psb_krylov_mod.f90 @@ -40,9 +40,10 @@ Module psb_krylov_mod interface psb_krylov - Subroutine psb_skrylov(method,a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,istop,cond) + Subroutine psb_skrylov(method,a,prec,b,x,eps,desc_a,info,& + & itmax,iter,err,itrace,irst,istop,cond) use psb_base_mod, only : psb_desc_type, psb_sspmat_type, psb_spk_ - use psb_prec_mod,only : psb_sprec_type, psb_dprec_type, psb_cprec_type, psb_zprec_type + use psb_prec_mod,only : psb_sprec_type character(len=*) :: method Type(psb_sspmat_type), Intent(in) :: a @@ -56,9 +57,30 @@ Module psb_krylov_mod Integer, Optional, Intent(out) :: iter Real(psb_spk_), Optional, Intent(out) :: err,cond end Subroutine psb_skrylov - Subroutine psb_ckrylov(method,a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,istop) + Subroutine psb_skrylov_vect(method,a,prec,b,x,eps,desc_a,info,& + & itmax,iter,err,itrace,irst,istop,cond) + + use psb_base_mod, only : psb_desc_type, psb_sspmat_type, & + & psb_spk_, psb_s_vect_type + use psb_prec_mod,only : psb_sprec_type + + character(len=*) :: method + Type(psb_sspmat_type), Intent(in) :: a + Type(psb_desc_type), Intent(in) :: desc_a + class(psb_sprec_type), intent(inout) :: prec + type(psb_s_vect_type), Intent(inout) :: b + type(psb_s_vect_type), Intent(inout) :: x + Real(psb_spk_), Intent(in) :: eps + integer, intent(out) :: info + Integer, Optional, Intent(in) :: itmax, itrace, irst,istop + Integer, Optional, Intent(out) :: iter + Real(psb_spk_), Optional, Intent(out) :: err,cond + + end Subroutine psb_skrylov_vect + Subroutine psb_ckrylov(method,a,prec,b,x,eps,desc_a,info,& + & itmax,iter,err,itrace,irst,istop) use psb_base_mod, only : psb_desc_type, psb_cspmat_type, psb_spk_ - use psb_prec_mod,only : psb_sprec_type, psb_dprec_type, psb_cprec_type, psb_zprec_type + use psb_prec_mod,only : psb_cprec_type character(len=*) :: method Type(psb_cspmat_type), Intent(in) :: a Type(psb_desc_type), Intent(in) :: desc_a @@ -71,27 +93,69 @@ Module psb_krylov_mod Integer, Optional, Intent(out) :: iter Real(psb_spk_), Optional, Intent(out) :: err end Subroutine psb_ckrylov - Subroutine psb_dkrylov(method,a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,istop,cond) + Subroutine psb_ckrylov_vect(method,a,prec,b,x,eps,desc_a,info,& + & itmax,iter,err,itrace,irst,istop,cond) + + use psb_base_mod, only : psb_desc_type, psb_cspmat_type, & + & psb_spk_, psb_c_vect_type + use psb_prec_mod,only : psb_cprec_type + + character(len=*) :: method + Type(psb_cspmat_type), Intent(in) :: a + Type(psb_desc_type), Intent(in) :: desc_a + class(psb_cprec_type), intent(inout) :: prec + type(psb_c_vect_type), Intent(inout) :: b + type(psb_c_vect_type), Intent(inout) :: x + Real(psb_spk_), Intent(in) :: eps + integer, intent(out) :: info + Integer, Optional, Intent(in) :: itmax, itrace, irst,istop + Integer, Optional, Intent(out) :: iter + Real(psb_spk_), Optional, Intent(out) :: err,cond + + end Subroutine psb_ckrylov_vect + Subroutine psb_dkrylov(method,a,prec,b,x,eps,desc_a,info,& + & itmax,iter,err,itrace,irst,istop,cond) use psb_base_mod, only : psb_desc_type, psb_dspmat_type, psb_dpk_ - use psb_prec_mod,only : psb_sprec_type, psb_dprec_type, psb_cprec_type, psb_zprec_type + use psb_prec_mod,only : psb_dprec_type character(len=*) :: method Type(psb_dspmat_type), Intent(in) :: a Type(psb_desc_type), Intent(in) :: desc_a - class(psb_dprec_type), intent(in) :: prec - Real(psb_dpk_), Intent(in) :: b(:) - Real(psb_dpk_), Intent(inout) :: x(:) - Real(psb_dpk_), Intent(in) :: eps + class(psb_dprec_type), intent(in) :: prec + Real(psb_dpk_), Intent(in) :: b(:) + Real(psb_dpk_), Intent(inout) :: x(:) + Real(psb_dpk_), Intent(in) :: eps integer, intent(out) :: info Integer, Optional, Intent(in) :: itmax, itrace, irst,istop Integer, Optional, Intent(out) :: iter Real(psb_dpk_), Optional, Intent(out) :: err,cond end Subroutine psb_dkrylov - Subroutine psb_zkrylov(method,a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,istop) + Subroutine psb_dkrylov_vect(method,a,prec,b,x,eps,desc_a,info,& + & itmax,iter,err,itrace,irst,istop,cond) + + use psb_base_mod, only : psb_desc_type, psb_dspmat_type, & + & psb_dpk_, psb_d_vect_type + use psb_prec_mod,only : psb_dprec_type + + character(len=*) :: method + Type(psb_dspmat_type), Intent(in) :: a + Type(psb_desc_type), Intent(in) :: desc_a + class(psb_dprec_type), intent(inout) :: prec + type(psb_d_vect_type), Intent(inout) :: b + type(psb_d_vect_type), Intent(inout) :: x + Real(psb_dpk_), Intent(in) :: eps + integer, intent(out) :: info + Integer, Optional, Intent(in) :: itmax, itrace, irst,istop + Integer, Optional, Intent(out) :: iter + Real(psb_dpk_), Optional, Intent(out) :: err,cond + + end Subroutine psb_dkrylov_vect + Subroutine psb_zkrylov(method,a,prec,b,x,eps,desc_a,info,& + & itmax,iter,err,itrace,irst,istop) use psb_base_mod, only : psb_desc_type, psb_zspmat_type, psb_dpk_ - use psb_prec_mod,only : psb_sprec_type, psb_dprec_type, psb_cprec_type, psb_zprec_type + use psb_prec_mod,only : psb_zprec_type character(len=*) :: method Type(psb_zspmat_type), Intent(in) :: a Type(psb_desc_type), Intent(in) :: desc_a @@ -104,6 +168,26 @@ Module psb_krylov_mod Integer, Optional, Intent(out) :: iter Real(psb_dpk_), Optional, Intent(out) :: err end Subroutine psb_zkrylov + Subroutine psb_zkrylov_vect(method,a,prec,b,x,eps,desc_a,info,& + & itmax,iter,err,itrace,irst,istop,cond) + + use psb_base_mod, only : psb_desc_type, psb_zspmat_type, & + & psb_dpk_, psb_z_vect_type + use psb_prec_mod,only : psb_zprec_type + + character(len=*) :: method + Type(psb_zspmat_type), Intent(in) :: a + Type(psb_desc_type), Intent(in) :: desc_a + class(psb_zprec_type), intent(inout) :: prec + type(psb_z_vect_type), Intent(inout) :: b + type(psb_z_vect_type), Intent(inout) :: x + Real(psb_dpk_), Intent(in) :: eps + integer, intent(out) :: info + Integer, Optional, Intent(in) :: itmax, itrace, irst,istop + Integer, Optional, Intent(out) :: iter + Real(psb_dpk_), Optional, Intent(out) :: err,cond + + end Subroutine psb_zkrylov_vect end interface diff --git a/krylov/psb_s_inner_krylov_mod.f90 b/krylov/psb_s_inner_krylov_mod.f90 index f70dd1763..79294f7b9 100644 --- a/krylov/psb_s_inner_krylov_mod.f90 +++ b/krylov/psb_s_inner_krylov_mod.f90 @@ -38,11 +38,11 @@ Module psb_s_inner_krylov_mod use psb_base_inner_krylov_mod interface psb_init_conv - module procedure psb_s_init_conv + module procedure psb_s_init_conv, psb_s_init_conv_vect end interface interface psb_check_conv - module procedure psb_s_check_conv + module procedure psb_s_check_conv, psb_s_check_conv_vect end interface @@ -116,7 +116,7 @@ contains end subroutine psb_s_init_conv - function psb_s_check_conv(methdname,it,x,r,desc_a,stopdat,info) + function psb_s_check_conv(methdname,it,x,r,desc_a,stopdat,info) result(res) use psb_base_mod implicit none character(len=*), intent(in) :: methdname @@ -124,7 +124,7 @@ contains real(psb_spk_), intent(in) :: x(:), r(:) type(psb_desc_type), intent(in) :: desc_a type(psb_itconv_type) :: stopdat - logical :: psb_s_check_conv + logical :: res integer, intent(out) :: info integer :: ictxt, me, np, err_act @@ -137,7 +137,7 @@ contains ictxt = desc_a%get_context() call psb_info(ictxt,me,np) - psb_s_check_conv = .false. + res = .false. select case(stopdat%controls(psb_ik_stopc_)) case(1) @@ -145,7 +145,8 @@ contains if (info == psb_success_) stopdat%values(psb_ik_xni_) = psb_geamax(x,desc_a,info) stopdat%values(psb_ik_errnum_) = stopdat%values(psb_ik_rni_) stopdat%values(psb_ik_errden_) = & - & (stopdat%values(psb_ik_ani_)*stopdat%values(psb_ik_xni_)+stopdat%values(psb_ik_bni_)) + & (stopdat%values(psb_ik_ani_)*stopdat%values(psb_ik_xni_)& + & +stopdat%values(psb_ik_bni_)) case(2) stopdat%values(psb_ik_rn2_) = psb_genrm2(r,desc_a,info) stopdat%values(psb_ik_errnum_) = stopdat%values(psb_ik_rn2_) @@ -163,16 +164,16 @@ contains end if if (stopdat%values(psb_ik_errden_) == dzero) then - psb_s_check_conv = (stopdat%values(psb_ik_errnum_) <= stopdat%values(psb_ik_eps_)) + res = (stopdat%values(psb_ik_errnum_) <= stopdat%values(psb_ik_eps_)) else - psb_s_check_conv = & - & (stopdat%values(psb_ik_errnum_) <= stopdat%values(psb_ik_eps_)*stopdat%values(psb_ik_errden_)) + res = (stopdat%values(psb_ik_errnum_) <=& + & stopdat%values(psb_ik_eps_)*stopdat%values(psb_ik_errden_)) end if - psb_s_check_conv = (psb_s_check_conv.or.(stopdat%controls(psb_ik_itmax_) <= it)) + res = (res.or.(stopdat%controls(psb_ik_itmax_) <= it)) if ( (stopdat%controls(psb_ik_trace_) > 0).and.& - & ((mod(it,stopdat%controls(psb_ik_trace_)) == 0).or.psb_s_check_conv)) then + & ((mod(it,stopdat%controls(psb_ik_trace_)) == 0).or.res)) then call log_conv(methdname,me,it,1,stopdat%values(psb_ik_errnum_),& & stopdat%values(psb_ik_errden_),stopdat%values(psb_ik_eps_)) end if @@ -189,4 +190,150 @@ contains end function psb_s_check_conv + subroutine psb_s_init_conv_vect(methdname,stopc,trace,itmax,a,b,eps,desc_a,stopdat,info) + use psb_base_mod + implicit none + character(len=*), intent(in) :: methdname + integer, intent(in) :: stopc, trace,itmax + type(psb_sspmat_type), intent(in) :: a + real(psb_spk_), intent(in) :: eps + type(psb_s_vect_type), intent(inout) :: b + type(psb_desc_type), intent(in) :: desc_a + type(psb_itconv_type) :: stopdat + integer, intent(out) :: info + + integer :: ictxt, me, np, err_act + character(len=20) :: name + + info = psb_success_ + name = 'psb_init_conv' + call psb_erractionsave(err_act) + + + ictxt=desc_a%get_context() + + call psb_info(ictxt, me, np) + + stopdat%controls(:) = 0 + stopdat%values(:) = szero + + stopdat%controls(psb_ik_stopc_) = stopc + stopdat%controls(psb_ik_trace_) = trace + stopdat%controls(psb_ik_itmax_) = itmax + + select case(stopdat%controls(psb_ik_stopc_)) + case (1) + stopdat%values(psb_ik_ani_) = psb_spnrmi(a,desc_a,info) + if (info == psb_success_)& + & stopdat%values(psb_ik_bni_) = psb_geamax(b,desc_a,info) + + case (2) + stopdat%values(psb_ik_bn2_) = psb_genrm2(b,desc_a,info) + + case default + info=psb_err_invalid_istop_ + call psb_errpush(info,name,i_err=(/stopc,0,0,0,0/)) + goto 9999 + end select + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,a_err="Init conv check data") + goto 9999 + end if + + stopdat%values(psb_ik_eps_) = eps + stopdat%values(psb_ik_errnum_) = szero + stopdat%values(psb_ik_errden_) = done + + if ((stopdat%controls(psb_ik_trace_) > 0).and. (me == 0))& + & call log_header(methdname) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + + end subroutine psb_s_init_conv_vect + + function psb_s_check_conv_vect(methdname,it,x,r,desc_a,stopdat,info) result(res) + use psb_base_mod + implicit none + character(len=*), intent(in) :: methdname + integer, intent(in) :: it + type(psb_s_vect_type), intent(inout) :: x, r + type(psb_desc_type), intent(in) :: desc_a + type(psb_itconv_type) :: stopdat + logical :: res + integer, intent(out) :: info + + integer :: ictxt, me, np, err_act + character(len=20) :: name + + info = psb_success_ + res = .false. + if (psb_errstatus_fatal()) return + name = 'psb_check_conv' + call psb_erractionsave(err_act) + + ictxt = desc_a%get_context() + call psb_info(ictxt,me,np) + + + + select case(stopdat%controls(psb_ik_stopc_)) + case(1) + stopdat%values(psb_ik_rni_) = psb_geamax(r,desc_a,info) + if (info == psb_success_) stopdat%values(psb_ik_xni_) = psb_geamax(x,desc_a,info) + stopdat%values(psb_ik_errnum_) = stopdat%values(psb_ik_rni_) + stopdat%values(psb_ik_errden_) = & + & (stopdat%values(psb_ik_ani_)*stopdat%values(psb_ik_xni_)& + & +stopdat%values(psb_ik_bni_)) + case(2) + stopdat%values(psb_ik_rn2_) = psb_genrm2(r,desc_a,info) + stopdat%values(psb_ik_errnum_) = stopdat%values(psb_ik_rn2_) + stopdat%values(psb_ik_errden_) = stopdat%values(psb_ik_bn2_) + + case default + info=psb_err_internal_error_ + call psb_errpush(info,name,a_err="Control data in stopdat messed up!") + goto 9999 + end select + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + if (stopdat%values(psb_ik_errden_) == dzero) then + res = (stopdat%values(psb_ik_errnum_) <= stopdat%values(psb_ik_eps_)) + else + res = (stopdat%values(psb_ik_errnum_) <=& + & stopdat%values(psb_ik_eps_)*stopdat%values(psb_ik_errden_)) + end if + + res = (res.or.(stopdat%controls(psb_ik_itmax_) <= it)) + + if ( (stopdat%controls(psb_ik_trace_) > 0).and.& + & ((mod(it,stopdat%controls(psb_ik_trace_)) == 0).or.res)) then + call log_conv(methdname,me,it,1,stopdat%values(psb_ik_errnum_),& + & stopdat%values(psb_ik_errden_),stopdat%values(psb_ik_eps_)) + 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(ictxt) + return + end if + + end function psb_s_check_conv_vect + + end module psb_s_inner_krylov_mod diff --git a/krylov/psb_sbicg.f90 b/krylov/psb_sbicg.f90 index 3a755fef2..a2aff0d21 100644 --- a/krylov/psb_sbicg.f90 +++ b/krylov/psb_sbicg.f90 @@ -97,7 +97,7 @@ subroutine psb_sbicg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) use psb_base_mod use psb_prec_mod - use psb_inner_krylov_mod + use psb_s_inner_krylov_mod use psb_krylov_mod implicit none @@ -308,10 +308,7 @@ subroutine psb_sbicg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) end do restart call psb_end_conv(methdname,itx,desc_a,stopdat,info,derr,iter) - - if (present(err)) then - err = derr - end if + if (present(err)) err = derr deallocate(aux, stat=info) if (info == psb_success_) call psb_gefree(wwrk,desc_a,info) @@ -335,4 +332,251 @@ subroutine psb_sbicg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) end subroutine psb_sbicg +subroutine psb_sbicg_vect(a,prec,b,x,eps,desc_a,info,& + & itmax,iter,err,itrace,istop) + use psb_base_mod + use psb_prec_mod + use psb_s_inner_krylov_mod + use psb_krylov_mod + implicit none + type(psb_sspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + class(psb_sprec_type), intent(inout) :: prec + type(psb_s_vect_type), Intent(inout) :: b + type(psb_s_vect_type), Intent(inout) :: x + real(psb_spk_), intent(in) :: eps + integer, intent(out) :: info + integer, optional, intent(in) :: itmax, itrace, istop + integer, optional, intent(out) :: iter + real(psb_spk_), optional, intent(out) :: err +!!$ local data + real(psb_spk_), allocatable, target :: aux(:) + type(psb_s_vect_type), allocatable, target :: wwrk(:) + type(psb_s_vect_type), pointer :: ww, q, r, p,& + & zt, pt, z, rt, qt + integer :: int_err(5) + integer :: itmax_, naux, mglob, it, itrace_,& + & np,me, n_row, n_col, istop_, err_act + integer :: debug_level, debug_unit + logical, parameter :: exchange=.true., noexchange=.false. + integer, parameter :: irmax = 8 + integer :: itx, isvch, ictxt + real(psb_spk_) :: alpha, beta, rho, rho_old, sigma + real(psb_dpk_) :: derr + type(psb_itconv_type) :: stopdat + character(len=20) :: name,ch_err + character(len=*), parameter :: methdname='BiCG' + + info = psb_success_ + name = 'psb_sbicg' + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt = desc_a%get_context() + call psb_info(ictxt, me, np) + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),': from psb_info',np + + mglob = desc_a%get_global_rows() + n_row = desc_a%get_local_rows() + n_col = desc_a%get_local_cols() + + ! Ensure global coherence for convergence checks. + call psb_set_coher(ictxt,isvch) + + if (.not.allocated(b%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + if (present(istop)) then + istop_ = istop + else + istop_ = 2 + endif + ! + ! istop_ = 1: normwise backward error, infinity norm + ! istop_ = 2: ||r||/||b|| norm 2 + ! + + if ((istop_ < 1 ).or.(istop_ > 2 ) ) then + info=psb_err_invalid_istop_ + int_err=istop_ + err=info + call psb_errpush(info,name,i_err=int_err) + goto 9999 + endif + + call psb_chkvect(mglob,1,x%get_nrows(),1,1,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_chkvect on X') + goto 9999 + end if + call psb_chkvect(mglob,1,b%get_nrows(),1,1,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_chkvect on B') + goto 9999 + end if + + + naux=4*n_col + + allocate(aux(naux),stat=info) + if (info == psb_success_) call psb_geall(wwrk,desc_a,info,n=9) + if (info == psb_success_) call psb_geasb(wwrk,desc_a,info,mold=x%v) + if(info /= psb_success_) then + info=psb_err_from_subroutine_non_ + ch_err='psb_asb' + err=info + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + q => wwrk(1) + qt => wwrk(2) + r => wwrk(3) + rt => wwrk(4) + p => wwrk(5) + pt => wwrk(6) + z => wwrk(7) + zt => wwrk(8) + ww => wwrk(9) + + if (present(itmax)) then + itmax_ = itmax + else + itmax_ = 1000 + endif + + if (present(itrace)) then + itrace_ = itrace + else + itrace_ = 0 + end if + + itx = 0 + + + call psb_init_conv(methdname,istop_,itrace_,itmax_,a,b,eps,desc_a,stopdat,info) + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + restart: do +!!$ +!!$ r0 = b-ax0 +!!$ + if (itx >= itmax_) exit restart + it = 0 + call psb_geaxpby(sone,b,szero,r,desc_a,info) + if (info == psb_success_) call psb_spmm(-sone,a,x,sone,r,desc_a,info,work=aux) + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),' Done spmm',info + if (info == psb_success_) call psb_geaxpby(sone,r,szero,rt,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + rho = szero + + ! Perhaps we already satisfy the convergence criterion... + if (psb_check_conv(methdname,itx,x,r,desc_a,stopdat,info)) exit restart + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + iteration: do + it = it + 1 + itx = itx + 1 + + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),'iteration: ',itx + + call prec%apply(r,z,desc_a,info,work=aux) + if (info == psb_success_) call prec%apply(rt,zt,desc_a,info,trans='t',work=aux) + + rho_old = rho + rho = psb_gedot(rt,z,desc_a,info) + if (rho == szero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' iteration breakdown r',rho + exit iteration + endif + + if (it == 1) then + call psb_geaxpby(sone,z,szero,p,desc_a,info) + call psb_geaxpby(sone,zt,szero,pt,desc_a,info) + else + beta = (rho/rho_old) + call psb_geaxpby(sone,z,beta,p,desc_a,info) + call psb_geaxpby(sone,zt,beta,pt,desc_a,info) + end if + + call psb_spmm(sone,a,p,szero,q,desc_a,info,& + & work=aux) + call psb_spmm(sone,a,pt,szero,qt,desc_a,info,& + & work=aux,trans='t') + + sigma = psb_gedot(pt,q,desc_a,info) + if (sigma == szero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' iteration breakdown s1', sigma + exit iteration + endif + + alpha = rho/sigma + + + call psb_geaxpby(alpha,p,sone,x,desc_a,info) + call psb_geaxpby(-alpha,q,sone,r,desc_a,info) + call psb_geaxpby(-alpha,qt,sone,rt,desc_a,info) + + if (psb_check_conv(methdname,itx,x,r,desc_a,stopdat,info)) exit restart + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + end do iteration + end do restart + + call psb_end_conv(methdname,itx,desc_a,stopdat,info,derr,iter) + if (present(err)) err = derr + + if (info == psb_success_) call psb_gefree(wwrk,desc_a,info) + if (info == psb_success_) deallocate(aux,stat=info) + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + ! restore external global coherence behaviour + call psb_restore_coher(ictxt,isvch) + + 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 psb_sbicg_vect diff --git a/krylov/psb_scg.F90 b/krylov/psb_scg.F90 index c4dfc70f6..112601698 100644 --- a/krylov/psb_scg.F90 +++ b/krylov/psb_scg.F90 @@ -98,7 +98,7 @@ subroutine psb_scg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop,cond) use psb_base_mod use psb_prec_mod - use psb_inner_krylov_mod + use psb_s_inner_krylov_mod use psb_krylov_mod implicit none @@ -287,7 +287,8 @@ subroutine psb_scg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop,cond) call sstebz('A','E',istebz,szero,szero,0,0,-sone,td,tu,& & ieg,nspl,eig,ibl,ispl,ewrk,iwrk,info) if (info < 0) then - call psb_errpush(psb_err_from_subroutine_ai_,name,a_err='sstebz',i_err=(/info,0,0,0,0/)) + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='sstebz',i_err=(/info,0,0,0,0/)) info = psb_err_from_subroutine_ai_ goto 9999 end if @@ -299,11 +300,9 @@ subroutine psb_scg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop,cond) end if call psb_bcast(ictxt,cond,root=0) end if - call psb_end_conv(methdname,itx,desc_a,stopdat,info,derr,iter) - if (present(err)) then - err = derr - end if + call psb_end_conv(methdname,itx,desc_a,stopdat,info,derr,iter) + if (present(err)) err = derr call psb_gefree(wwrk,desc_a,info) if (info /= psb_success_) then @@ -327,4 +326,245 @@ subroutine psb_scg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop,cond) end subroutine psb_scg +subroutine psb_scg_vect(a,prec,b,x,eps,desc_a,info,& + & itmax,iter,err,itrace,istop,cond) + use psb_base_mod + use psb_prec_mod + use psb_s_inner_krylov_mod + use psb_krylov_mod + implicit none + type(psb_sspmat_type), intent(in) :: a + Type(psb_desc_type), Intent(in) :: desc_a + class(psb_sprec_type), intent(inout) :: prec + type(psb_s_vect_type), Intent(inout) :: b + type(psb_s_vect_type), Intent(inout) :: x + Real(psb_spk_), Intent(in) :: eps + integer, intent(out) :: info + Integer, Optional, Intent(in) :: itmax, itrace, istop + Integer, Optional, Intent(out) :: iter + Real(psb_spk_), Optional, Intent(out) :: err,cond +!!$ Local data + real(psb_spk_), allocatable, target :: aux(:), td(:),tu(:),eig(:),ewrk(:) + integer, allocatable :: ibl(:), ispl(:), iwrk(:) + type(psb_s_vect_type), allocatable, target :: wwrk(:) + type(psb_s_vect_type), pointer :: q, p, r, z, w + real(psb_spk_) :: alpha, beta, rho, rho_old, sigma,alpha_old,beta_old + integer :: itmax_, istop_, naux, mglob, it, itx, itrace_,& + & np,me, n_col, isvch, ictxt, n_row,err_act, int_err(5), ieg,nspl, istebz + integer :: debug_level, debug_unit + real(psb_dpk_) :: derr + type(psb_itconv_type) :: stopdat + logical :: do_cond + character(len=20) :: name + character(len=*), parameter :: methdname='CG' + info = psb_success_ + name = 'psb_scg' + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt = desc_a%get_context() + + call psb_info(ictxt, me, np) + if (.not.allocated(b%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + mglob = desc_a%get_global_rows() + n_row = desc_a%get_local_rows() + n_col = desc_a%get_local_cols() + + + if (present(istop)) then + istop_ = istop + else + istop_ = 2 + endif + + call psb_chkvect(mglob,1,x%get_nrows(),1,1,desc_a,info) + if (info == psb_success_)& + & call psb_chkvect(mglob,1,b%get_nrows(),1,1,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_chkvect on X/B') + goto 9999 + end if + + naux=4*n_col + allocate(aux(naux), stat=info) + if (info == psb_success_) call psb_geall(wwrk,desc_a,info,n=5) + if (info == psb_success_) call psb_geasb(wwrk,desc_a,info,mold=x%v) + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + p => wwrk(1) + q => wwrk(2) + r => wwrk(3) + z => wwrk(4) + w => wwrk(5) + + + if (present(itmax)) then + itmax_ = itmax + else + itmax_ = 1000 + endif + + if (present(itrace)) then + itrace_ = itrace + else + itrace_ = 0 + end if + + do_cond=present(cond) + if (do_cond) then + istebz = 0 + allocate(td(itmax_),tu(itmax_), eig(itmax_),& + & ibl(itmax_),ispl(itmax_),iwrk(3*itmax_),ewrk(4*itmax_),& + & stat=info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + end if + + itx=0 + + ! Ensure global coherence for convergence checks. + call psb_set_coher(ictxt,isvch) + + restart: do +!!$ +!!$ r0 = b-Ax0 +!!$ + if (itx>= itmax_) exit restart + + it = 0 + call psb_geaxpby(sone,b,szero,r,desc_a,info) + if (info == psb_success_) call psb_spmm(-sone,a,x,sone,r,desc_a,info,work=aux) + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + rho = szero + + call psb_init_conv(methdname,istop_,itrace_,itmax_,a,b,eps,desc_a,stopdat,info) + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + iteration: do + + it = it + 1 + itx = itx + 1 + + call prec%apply(r,z,desc_a,info,work=aux) + rho_old = rho + rho = psb_gedot(r,z,desc_a,info) + + if (it == 1) then + call psb_geaxpby(sone,z,szero,p,desc_a,info) + else + if (rho_old == szero) then + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),& + & ': CG Iteration breakdown rho' + exit iteration + endif + beta = rho/rho_old + call psb_geaxpby(sone,z,beta,p,desc_a,info) + end if + + call psb_spmm(sone,a,p,szero,q,desc_a,info,work=aux) + sigma = psb_gedot(p,q,desc_a,info) + if (sigma == szero) then + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),& + & ': CG Iteration breakdown sigma' + exit iteration + endif + alpha_old = alpha + alpha = rho/sigma + if (do_cond) then + istebz = istebz + 1 + if (istebz == 1) then + td(istebz) = sone/alpha + else + td(istebz) = sone/alpha + beta/alpha_old + tu(istebz-1) = sqrt(beta)/alpha_old + end if + end if + + call psb_geaxpby(alpha,p,sone,x,desc_a,info) + call psb_geaxpby(-alpha,q,sone,r,desc_a,info) + + if (psb_check_conv(methdname,itx,x,r,desc_a,stopdat,info)) exit restart + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + end do iteration + end do restart + + if (do_cond) then + if (me == 0) then +#if defined(HAVE_LAPACK) + call sstebz('A','E',istebz,szero,szero,0,0,-sone,td,tu,& + & ieg,nspl,eig,ibl,ispl,ewrk,iwrk,info) + if (info < 0) then + call psb_errpush(psb_err_from_subroutine_ai_,name,& + & a_err='dstebz',i_err=(/info,0,0,0,0/)) + info = psb_err_from_subroutine_ai_ + goto 9999 + end if + cond = eig(ieg)/eig(1) +#else + cond = -1.0 +#endif + info = psb_success_ + end if + call psb_bcast(ictxt,cond,root=0) + end if + + call psb_end_conv(methdname,itx,desc_a,stopdat,info,derr,iter) + if (present(err)) err = derr + + if (info == psb_success_) call psb_gefree(wwrk,desc_a,info) + if (info == psb_success_) deallocate(aux,stat=info) + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + + ! restore external global coherence behaviour + call psb_restore_coher(ictxt,isvch) + + 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 psb_scg_vect diff --git a/krylov/psb_scgs.f90 b/krylov/psb_scgs.f90 index 087eb2eb3..15ed66c3e 100644 --- a/krylov/psb_scgs.f90 +++ b/krylov/psb_scgs.f90 @@ -97,7 +97,7 @@ Subroutine psb_scgs(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) use psb_base_mod use psb_prec_mod - use psb_inner_krylov_mod + use psb_s_inner_krylov_mod use psb_krylov_mod implicit none @@ -328,3 +328,245 @@ Subroutine psb_scgs(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) return End Subroutine psb_scgs + +Subroutine psb_scgs_vect(a,prec,b,x,eps,desc_a,info,& + & itmax,iter,err,itrace,istop) + use psb_base_mod + use psb_prec_mod + use psb_s_inner_krylov_mod + use psb_krylov_mod + implicit none + type(psb_sspmat_type), intent(in) :: a + Type(psb_desc_type), Intent(in) :: desc_a + class(psb_sprec_type), intent(inout) :: prec + type(psb_s_vect_type), Intent(inout) :: b + type(psb_s_vect_type), Intent(inout) :: x + Real(psb_spk_), Intent(in) :: eps + integer, intent(out) :: info + Integer, Optional, Intent(in) :: itmax, itrace,istop + Integer, Optional, Intent(out) :: iter + Real(psb_spk_), Optional, Intent(out) :: err +!!$ local data + Real(psb_spk_), allocatable, target :: aux(:) + type(psb_s_vect_type), allocatable, target :: wwrk(:) + type(psb_s_vect_type), pointer :: ww, q, r, p, v,& + & s, z, f, rt, qt, uv + Integer :: itmax_, naux, mglob, it, itrace_,int_err(5),& + & np,me, n_row, n_col,istop_, err_act + Integer :: itx, isvch, ictxt + integer :: debug_level, debug_unit + Real(psb_spk_) :: alpha, beta, rho, rho_old, sigma + real(psb_dpk_) :: derr + type(psb_itconv_type) :: stopdat + character(len=20) :: name + character(len=*), parameter :: methdname='CGS' + + info = psb_success_ + name = 'psb_scgs' + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt = desc_a%get_context() + Call psb_info(ictxt, me, np) + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),': from psb_info',np + if (.not.allocated(b%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + mglob = desc_a%get_global_rows() + n_row = desc_a%get_local_rows() + n_col = desc_a%get_local_cols() + + If (Present(istop)) Then + istop_ = istop + Else + istop_ = 2 + Endif + + call psb_chkvect(mglob,1,x%get_nrows(),1,1,desc_a,info) + if (info == psb_success_) call psb_chkvect(mglob,1,b%get_nrows(),1,1,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_chkvect on X/B') + goto 9999 + end if + + naux=4*n_col + Allocate(aux(naux),stat=info) + if (info == psb_success_) Call psb_geall(wwrk,desc_a,info,n=11) + if (info == psb_success_) Call psb_geasb(wwrk,desc_a,info,mold=x%v) + if (info /= psb_success_) Then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + End If + + q => wwrk(1) + qt => wwrk(2) + r => wwrk(3) + rt => wwrk(4) + p => wwrk(5) + v => wwrk(6) + uv => wwrk(7) + z => wwrk(8) + f => wwrk(9) + s => wwrk(10) + ww => wwrk(11) + + + If (Present(itmax)) Then + itmax_ = itmax + Else + itmax_ = 1000 + Endif + + If (Present(itrace)) Then + itrace_ = itrace + Else + itrace_ = 0 + End If + + ! Ensure global coherence for convergence checks. + call psb_set_coher(ictxt,isvch) + + itx = 0 + + call psb_init_conv(methdname,istop_,itrace_,itmax_,a,b,eps,desc_a,stopdat,info) + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + restart: Do +!!$ +!!$ r0 = b-ax0 +!!$ + if (itx >= itmax_) exit restart + it = 0 + call psb_geaxpby(sone,b,szero,r,desc_a,info) + if (info == psb_success_) call psb_spmm(-sone,a,x,sone,r,desc_a,info,work=aux) + if (info == psb_success_) call psb_geaxpby(sone,r,szero,rt,desc_a,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + + ! Perhaps we already satisfy the convergence criterion... + if (psb_check_conv(methdname,itx,x,r,desc_a,stopdat,info)) exit restart + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + rho = szero + + iteration: do + it = it + 1 + itx = itx + 1 + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),'iteration: ',itx + + rho_old = rho + rho = psb_gedot(rt,r,desc_a,info) + + if (rho == szero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' iteration breakdown r',rho + exit iteration + endif + + if (it == 1) then + call psb_geaxpby(sone,r,szero,uv,desc_a,info) + if (info == psb_success_) call psb_geaxpby(sone,r,szero,p,desc_a,info) + else + beta = (rho/rho_old) + call psb_geaxpby(sone,r,szero,uv,desc_a,info) + if (info == psb_success_) call psb_geaxpby(beta,q,sone,uv,desc_a,info) + if (info == psb_success_) call psb_geaxpby(sone,q,beta,p,desc_a,info) + if (info == psb_success_) call psb_geaxpby(sone,uv,beta,p,desc_a,info) + end if + + if (info == psb_success_) call prec%apply(p,f,desc_a,info,work=aux) + + if (info == psb_success_) call psb_spmm(sone,a,f,szero,v,desc_a,info,& + & work=aux) + + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='First loop part ') + goto 9999 + end if + + sigma = psb_gedot(rt,v,desc_a,info) + if (sigma == szero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' iteration breakdown s1', sigma + exit iteration + endif + + alpha = rho/sigma + + if (info == psb_success_) call psb_geaxpby(sone,uv,szero,q,desc_a,info) + if (info == psb_success_) call psb_geaxpby(-alpha,v,sone,q,desc_a,info) + if (info == psb_success_) call psb_geaxpby(sone,uv,szero,s,desc_a,info) + if (info == psb_success_) call psb_geaxpby(sone,q,sone,s,desc_a,info) + + if (info == psb_success_) call prec%apply(s,z,desc_a,info,work=aux) + + if (info == psb_success_) call psb_geaxpby(alpha,z,sone,x,desc_a,info) + + if (info == psb_success_) call psb_spmm(sone,a,z,szero,qt,desc_a,info,& + & work=aux) + + if (info == psb_success_) call psb_geaxpby(-alpha,qt,sone,r,desc_a,info) + + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='X update ') + goto 9999 + end if + + if (psb_check_conv(methdname,itx,x,r,desc_a,stopdat,info)) exit restart + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + end do iteration + end do restart + + call psb_end_conv(methdname,itx,desc_a,stopdat,info,derr,iter) + if (present(err)) err = derr + + if (info == psb_success_) call psb_gefree(wwrk,desc_a,info) + if (info == psb_success_) deallocate(aux,stat=info) + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + + ! restore external global coherence behaviour + call psb_restore_coher(ictxt,isvch) + 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 psb_scgs_vect diff --git a/krylov/psb_scgstab.F90 b/krylov/psb_scgstab.F90 index a6bb4af03..f0dd8db03 100644 --- a/krylov/psb_scgstab.F90 +++ b/krylov/psb_scgstab.F90 @@ -97,7 +97,7 @@ Subroutine psb_scgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) use psb_base_mod use psb_prec_mod - use psb_inner_krylov_mod + use psb_s_inner_krylov_mod use psb_krylov_mod Implicit None !!$ parameters @@ -124,7 +124,7 @@ Subroutine psb_scgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) Integer :: istop_ real(psb_dpk_) :: derr Real(psb_spk_) :: alpha, beta, omega - Real(psb_dpk_) :: rho, rho_old, sigma, tau + Real(psb_spk_) :: rho, rho_old, sigma, tau type(psb_itconv_type) :: stopdat #ifdef MPE_KRYLOV @@ -197,9 +197,9 @@ Subroutine psb_scgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) if (info == psb_success_) call psb_geall(wwrk,desc_a,info,n=8) if (info == psb_success_) call psb_geasb(wwrk,desc_a,info) if (info /= psb_success_) then - info=psb_err_from_subroutine_non_ - call psb_errpush(info,name) - goto 9999 + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 End If Q => WWRK(:,1) @@ -218,23 +218,23 @@ Subroutine psb_scgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) Endif If (Present(itrace)) Then - itrace_ = itrace + itrace_ = itrace Else - itrace_ = 0 + itrace_ = 0 End If - + ! Ensure global coherence for convergence checks. call psb_set_coher(ictxt,isvch) itx = 0 call psb_init_conv(methdname,istop_,itrace_,itmax_,a,b,eps,desc_a,stopdat,info) if (info /= psb_success_) Then - call psb_errpush(psb_err_from_subroutine_non_,name) - goto 9999 + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 End If restart: Do - + if (itx >= itmax_) exit restart it = 0 @@ -248,9 +248,9 @@ Subroutine psb_scgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) #endif if (info == psb_success_) call psb_geaxpby(sone,r,szero,q,desc_a,info) if (info /= psb_success_) then - info=psb_err_from_subroutine_ - call psb_errpush(info,name,a_err='Init residual') - goto 9999 + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='Init residual') + goto 9999 end if ! Perhaps we already satisfy the convergence criterion... @@ -259,7 +259,7 @@ Subroutine psb_scgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) call psb_errpush(psb_err_from_subroutine_non_,name) goto 9999 End If - + rho = szero iteration: Do @@ -274,9 +274,9 @@ Subroutine psb_scgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) rho = psb_gedot(q,r,desc_a,info) if (rho == szero) then - if (debug_level >= psb_debug_ext_) & - & write(debug_unit,*) me,' ',trim(name),& - & ' Iteration breakdown R',rho + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' Iteration breakdown R',rho exit iteration endif @@ -304,10 +304,10 @@ Subroutine psb_scgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) sigma = psb_gedot(q,v,desc_a,info) if (sigma == szero) then - if (debug_level >= psb_debug_ext_) & - & write(debug_unit,*) me,' ',trim(name),& - & ' Iteration breakdown S1', sigma - exit iteration + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' Iteration breakdown S1', sigma + exit iteration endif alpha = rho/sigma @@ -315,10 +315,10 @@ Subroutine psb_scgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) if (info == psb_success_) call psb_geaxpby(-alpha,v,sone,s,desc_a,info) if(info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_geaxpby') - goto 9999 + call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_geaxpby') + goto 9999 end if - + #ifdef MPE_KRYLOV imerr = MPE_Log_event( ifctb, 0, "st PREC" ) #endif @@ -335,25 +335,25 @@ Subroutine psb_scgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) imerr = MPE_Log_event( imme, 0, "ed SPMM" ) #endif if(info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='precaply/spmm') - goto 9999 + call psb_errpush(psb_err_from_subroutine_,name,a_err='precaply/spmm') + goto 9999 end if - + sigma = psb_gedot(t,t,desc_a,info) if (sigma == szero) then - if (debug_level >= psb_debug_ext_) & - & write(debug_unit,*) me,' ',trim(name),& - & ' Iteration breakdown S2', sigma + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' Iteration breakdown S2', sigma exit iteration endif - + tau = psb_gedot(t,s,desc_a,info) omega = tau/sigma if (omega == szero) then - if (debug_level >= psb_debug_ext_) & - & write(debug_unit,*) me,' ',trim(name),& - & ' Iteration breakdown O',omega + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' Iteration breakdown O',omega exit iteration endif @@ -365,13 +365,13 @@ Subroutine psb_scgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) call psb_errpush(psb_err_from_subroutine_,name,a_err='X/R update ') goto 9999 End If - + if (psb_check_conv(methdname,itx,x,r,desc_a,stopdat,info)) exit restart if (info /= psb_success_) Then call psb_errpush(psb_err_from_subroutine_non_,name) goto 9999 End If - + end do iteration end do restart @@ -383,8 +383,8 @@ Subroutine psb_scgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) deallocate(aux,stat=info) if (info == psb_success_) call psb_gefree(wwrk,desc_a,info) if(info /= psb_success_) then - call psb_errpush(info,name) - goto 9999 + call psb_errpush(info,name) + goto 9999 end if #ifdef MPE_KRYLOV imerr = MPE_Log_event( istpe, 0, "ed CGSTAB" ) @@ -398,10 +398,328 @@ Subroutine psb_scgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) 9999 continue call psb_erractionrestore(err_act) if (err_act == psb_act_abort_) then - call psb_error(ictxt) - return + call psb_error(ictxt) + return end if return End Subroutine psb_scgstab +Subroutine psb_scgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) + use psb_base_mod + use psb_prec_mod + use psb_s_inner_krylov_mod + use psb_krylov_mod + implicit none + type(psb_sspmat_type), intent(in) :: a + class(psb_sprec_type), Intent(inout) :: prec + Type(psb_desc_type), Intent(in) :: desc_a + type(psb_s_vect_type), Intent(inout) :: b + type(psb_s_vect_type), Intent(inout) :: x + Real(psb_spk_), Intent(in) :: eps + integer, intent(out) :: info + Integer, Optional, Intent(in) :: itmax, itrace, istop + Integer, Optional, Intent(out) :: iter + Real(psb_spk_), Optional, Intent(out) :: err +!!$ Local data + Real(psb_spk_), allocatable, target :: aux(:),wwrk(:,:) +!!$ Real(psb_spk_), Pointer :: q(:),& +!!$ & r(:), p(:), v(:), s(:), t(:), z(:), f(:) + type(psb_s_vect_type) :: q, r, p, v, s, t, z, f + + Integer :: itmax_, naux, mglob, it,itrace_,& + & np,me, n_row, n_col + integer :: debug_level, debug_unit + Logical, Parameter :: exchange=.True., noexchange=.False., debug1 = .False. + Integer, Parameter :: irmax = 8 + Integer :: itx, isvch, ictxt, err_act, i + Integer :: istop_ + real(psb_dpk_) :: derr + Real(psb_spk_) :: alpha, beta, rho, rho_old, sigma, omega, tau + type(psb_itconv_type) :: stopdat + + character(len=20) :: name + character(len=*), parameter :: methdname='BiCGStab' + + info = psb_success_ + name = 'psb_scgstab' + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + ictxt = desc_a%get_context() + call psb_info(ictxt, me, np) + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),': from psb_info',np + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(b%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + mglob = desc_a%get_global_rows() + n_row = desc_a%get_local_rows() + n_col = desc_a%get_local_cols() + + If (Present(istop)) Then + istop_ = istop + Else + istop_ = 2 + Endif + ! + ! ISTOP_ = 1: Normwise backward error, infinity norm + ! ISTOP_ = 2: ||r||/||b|| norm 2 + ! +!!$ if (.not.same_type_as(x,b)) then +!!$ write(0,*) 'Warning: different dynamic types for X and B ' +!!$ end if + + call psb_chkvect(mglob,1,x%get_nrows(),1,1,desc_a,info) + if (psb_errstatus_fatal()) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_chkvect on X') + goto 9999 + end if + call psb_chkvect(mglob,1,b%get_nrows(),1,1,desc_a,info) + if (psb_errstatus_fatal()) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_chkvect on B') + goto 9999 + end if + naux=6*n_col + if (info == psb_success_) allocate(aux(naux),stat=info) + if (info /= psb_success_) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + End If + + + call psb_geall(q,desc_a,info) + call psb_geall(r,desc_a,info) + call psb_geall(p,desc_a,info) + call psb_geall(v,desc_a,info) + call psb_geall(s,desc_a,info) + call psb_geall(t,desc_a,info) + call psb_geall(z,desc_a,info) + call psb_geall(f,desc_a,info) + + call psb_geasb(q,desc_a,info,mold=x%v) + call psb_geasb(r,desc_a,info,mold=x%v) + call psb_geasb(p,desc_a,info,mold=x%v) + call psb_geasb(v,desc_a,info,mold=x%v) + call psb_geasb(s,desc_a,info,mold=x%v) + call psb_geasb(t,desc_a,info,mold=x%v) + call psb_geasb(z,desc_a,info,mold=x%v) + call psb_geasb(f,desc_a,info,mold=x%v) + + + if (psb_errstatus_fatal()) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + End If + + If (Present(itmax)) Then + itmax_ = itmax + Else + itmax_ = 1000 + Endif + + If (Present(itrace)) Then + itrace_ = itrace + Else + itrace_ = 0 + End If + + ! Ensure global coherence for convergence checks. + call psb_set_coher(ictxt,isvch) + + itx = 0 + call psb_init_conv(methdname,istop_,itrace_,itmax_,a,b,eps,desc_a,stopdat,info) + if (psb_errstatus_fatal()) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + restart: Do + + if (itx >= itmax_) exit restart + + it = 0 + call psb_geaxpby(sone,b,szero,r,desc_a,info) + + call psb_spmm(-sone,a,x,sone,r,desc_a,info,work=aux) + call psb_geaxpby(sone,r,szero,q,desc_a,info) + + ! Perhaps we already satisfy the convergence criterion... + if (psb_check_conv(methdname,itx,x,r,desc_a,stopdat,info)) exit restart + + if (psb_errstatus_fatal()) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='Init residual chk') + goto 9999 + end if + + + rho = szero + + iteration: Do + it = it + 1 + itx = itx + 1 + + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),& + & ' Iteration: ',itx + + rho_old = rho + rho = psb_gedot(q,r,desc_a,info) + + if (debug_level >= psb_debug_ext_) then + call q%sync() + call r%sync() + end if + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),& + & ' Rho: ',rho + + if (rho == szero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' Iteration breakdown R',rho + exit iteration + endif + + if (it == 1) then + call psb_geaxpby(sone,r,szero,p,desc_a,info) + else + beta = (rho/rho_old)*(alpha/omega) + call psb_geaxpby(-omega,v,sone,p,desc_a,info) + call psb_geaxpby(sone,r,beta,p,desc_a,info) + End If + + call prec%apply(p,f,desc_a,info,work=aux) + + call psb_spmm(sone,a,f,szero,v,desc_a,info,& + & work=aux) + + + sigma = psb_gedot(q,v,desc_a,info) + + if (debug_level >= psb_debug_ext_) then + call q%sync() + call v%sync() + end if + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),& + & ' Sigma: ',sigma + + + if (sigma == szero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' Iteration breakdown S1', sigma + exit iteration + endif + + alpha = rho/sigma + call psb_geaxpby(sone,r,szero,s,desc_a,info) + call psb_geaxpby(-alpha,v,sone,s,desc_a,info) + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),& + & ' alpha: ',alpha + + + if (psb_errstatus_fatal()) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_geaxpby') + goto 9999 + end if + + + call prec%apply(s,z,desc_a,info,work=aux) + Call psb_spmm(sone,a,z,szero,t,desc_a,info,work=aux) + + if(psb_errstatus_fatal()) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='precaply/spmm') + goto 9999 + end if + + sigma = psb_gedot(t,t,desc_a,info) + if (sigma == szero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' Iteration breakdown S2', sigma + exit iteration + endif + + tau = psb_gedot(t,s,desc_a,info) + omega = tau/sigma + + if (debug_level >= psb_debug_ext_) then + call t%sync() + call s%sync() + end if + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),& + & ' sigma, tau, omega: ',sigma, tau, omega + + + if (omega == szero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' Iteration breakdown O',omega + exit iteration + endif + + call psb_geaxpby(alpha,f,sone,x,desc_a,info) + call psb_geaxpby(omega,z,sone,x,desc_a,info) + call psb_geaxpby(sone,s,szero,r,desc_a,info) + call psb_geaxpby(-omega,t,sone,r,desc_a,info) + if (psb_check_conv(methdname,itx,x,r,desc_a,stopdat,info)) exit restart + + if (psb_errstatus_fatal()) Then + call psb_errpush(psb_err_from_subroutine_,name,a_err='X/R update ') + goto 9999 + End If + + end do iteration + end do restart + + call psb_end_conv(methdname,itx,desc_a,stopdat,info,derr,iter) + if (present(err)) err = derr + + deallocate(aux,stat=info) + + call x%sync() + call psb_gefree(q,desc_a,info) + call psb_gefree(r,desc_a,info) + call psb_gefree(p,desc_a,info) + call psb_gefree(v,desc_a,info) + call psb_gefree(s,desc_a,info) + call psb_gefree(t,desc_a,info) + call psb_gefree(z,desc_a,info) + call psb_gefree(f,desc_a,info) + + if(psb_errstatus_fatal()) then + call psb_errpush(info,name) + goto 9999 + end if + ! restore external global coherence behaviour + call psb_restore_coher(ictxt,isvch) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +End Subroutine psb_scgstab_vect diff --git a/krylov/psb_scgstabl.f90 b/krylov/psb_scgstabl.f90 index 2e949f5bf..c4434a168 100644 --- a/krylov/psb_scgstabl.f90 +++ b/krylov/psb_scgstabl.f90 @@ -106,7 +106,7 @@ Subroutine psb_scgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,istop) use psb_base_mod use psb_prec_mod - use psb_inner_krylov_mod + use psb_s_inner_krylov_mod use psb_krylov_mod implicit none @@ -411,4 +411,327 @@ Subroutine psb_scgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,is End Subroutine psb_scgstabl +Subroutine psb_scgstabl_vect(a,prec,b,x,eps,desc_a,info,& + & itmax,iter,err,itrace,irst,istop) + use psb_base_mod + use psb_prec_mod + use psb_s_inner_krylov_mod + use psb_krylov_mod + implicit none + type(psb_sspmat_type), intent(in) :: a + class(psb_sprec_type), Intent(inout) :: prec + Type(psb_desc_type), Intent(in) :: desc_a + type(psb_s_vect_type), Intent(inout) :: b + type(psb_s_vect_type), Intent(inout) :: x + Real(psb_spk_), Intent(in) :: eps + integer, intent(out) :: info + Integer, Optional, Intent(in) :: itmax, itrace, irst,istop + Integer, Optional, Intent(out) :: iter + Real(psb_spk_), Optional, Intent(out) :: err +!!$ local data + Real(psb_spk_), allocatable, target :: aux(:), gamma(:),& + & gamma1(:), gamma2(:), taum(:,:), sigma(:) + type(psb_s_vect_type), allocatable, target :: wwrk(:),uh(:), rh(:) + type(psb_s_vect_type), Pointer :: ww, q, r, rt0, p, v, & + & s, t, z, f + + Integer :: itmax_, naux, mglob, it, itrace_,& + & np,me, n_row, n_col, nl, err_act + Logical, Parameter :: exchange=.True., noexchange=.False. + Integer, Parameter :: irmax = 8 + Integer :: itx, i, isvch, ictxt,istop_,j, k, int_err(5) + integer :: debug_level, debug_unit + Real(psb_spk_) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,& + & omega + real(psb_dpk_) :: derr + type(psb_itconv_type) :: stopdat + character(len=20) :: name + character(len=*), parameter :: methdname='BiCGStab(L)' + + info = psb_success_ + name = 'psb_scgstabl' + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt = desc_a%get_context() + Call psb_info(ictxt, me, np) + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),': from psb_info',np + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(b%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + mglob = desc_a%get_global_rows() + n_row = desc_a%get_local_rows() + n_col = desc_a%get_local_cols() + + if (present(istop)) then + istop_ = istop + else + istop_ = 2 + endif + + if (present(itmax)) then + itmax_ = itmax + else + itmax_ = 1000 + endif + + if (present(itrace)) then + itrace_ = itrace + else + itrace_ = 0 + end if + + if (present(irst)) then + nl = irst + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & 'present: irst: ',irst,nl + else + nl = 1 + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' not present: irst: ',irst,nl + endif + if (nl <=0 ) then + info=psb_err_invalid_istop_ + int_err(1)=nl + err=info + call psb_errpush(info,name,i_err=int_err) + goto 9999 + endif + + call psb_chkvect(mglob,1,x%get_nrows(),1,1,desc_a,info) + if (info == psb_success_) call psb_chkvect(mglob,1,b%get_nrows(),1,1,desc_a,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_chkvect on X/B') + goto 9999 + end if + + naux=4*n_col + allocate(aux(naux),gamma(0:nl),gamma1(nl),& + &gamma2(nl),taum(nl,nl),sigma(nl), stat=info) + + if (info /= psb_success_) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + end if + if (info == psb_success_) Call psb_geall(wwrk,desc_a,info,n=10) + if (info == psb_success_) Call psb_geall(uh,desc_a,info,n=nl+1,lb=0) + if (info == psb_success_) Call psb_geall(rh,desc_a,info,n=nl+1,lb=0) + if (info == psb_success_) Call psb_geasb(wwrk,desc_a,info,mold=x%v) + if (info == psb_success_) Call psb_geasb(uh,desc_a,info,mold=x%v) + if (info == psb_success_) Call psb_geasb(rh,desc_a,info,mold=x%v) + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + q => wwrk(1) + r => wwrk(2) + p => wwrk(3) + v => wwrk(4) + f => wwrk(5) + s => wwrk(6) + t => wwrk(7) + z => wwrk(8) + ww => wwrk(9) + rt0 => wwrk(10) + + ! Ensure global coherence for convergence checks. + call psb_set_coher(ictxt,isvch) + + + call psb_init_conv(methdname,istop_,itrace_,itmax_,a,b,eps,desc_a,stopdat,info) + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + itx = 0 + restart: do +!!$ +!!$ r0 = b-ax0 +!!$ + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),' restart: ',itx,it + if (itx >= itmax_) exit restart + + it = 0 + call psb_geaxpby(sone,b,szero,r,desc_a,info) + if (info == psb_success_) call psb_spmm(-sone,a,x,sone,r,desc_a,info,work=aux) + + if (info == psb_success_) call prec%apply(r,desc_a,info) + + if (info == psb_success_) call psb_geaxpby(sone,r,szero,rt0,desc_a,info) + if (info == psb_success_) call psb_geaxpby(sone,r,szero,rh(0),desc_a,info) + if (info == psb_success_) call psb_geaxpby(szero,r,szero,uh(0),desc_a,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + rho = sone + alpha = szero + omega = sone + + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' on entry to amax: b: ',b%get_nrows() + + if (psb_check_conv(methdname,itx,x,r,desc_a,stopdat,info)) exit restart + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + iteration: do + it = it + nl + itx = itx + nl + rho = -omega*rho + + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' iteration: ',itx, rho + + do j = 0, nl -1 + If (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),'bicg part: ',j, nl + + rho_old = rho + rho = psb_gedot(rh(j),rt0,desc_a,info) + if (rho == szero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' bi-cgstab iteration breakdown r',rho + exit iteration + endif + + beta = alpha*rho/rho_old + rho_old = rho + do k=0, j +!!$ call psb_geaxpby(sone,rh(:,0:j),-beta,uh(:,0:j),desc_a,info) + call psb_geaxpby(sone,rh(k),-beta,uh(k),desc_a,info) + end do + call psb_spmm(sone,a,uh(j),szero,uh(j+1),desc_a,info,work=aux) + + call prec%apply(uh(j+1),desc_a,info) + + gamma(j) = psb_gedot(uh(j+1),rt0,desc_a,info) + + if (gamma(j) == szero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' bi-cgstab iteration breakdown s2',gamma(j) + exit iteration + endif + alpha = rho/gamma(j) + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' bicg part: alpha=r/g ',alpha,rho,gamma(j) + + do k=0,j +!!$ call psb_geaxpby(-alpha,uh(:,1:j+1),sone,rh(:,0:j),desc_a,info) + call psb_geaxpby(-alpha,uh(k+1),sone,rh(k),desc_a,info) + end do + call psb_geaxpby(alpha,uh(0),sone,x,desc_a,info) + call psb_spmm(sone,a,rh(j),szero,rh(j+1),desc_a,info,work=aux) + + call prec%apply(rh(j+1),desc_a,info) + + enddo + + do j=1, nl + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' mod g-s part: ',j, nl + + do i=1, j-1 + taum(i,j) = psb_gedot(rh(i),rh(j),desc_a,info) + taum(i,j) = taum(i,j)/sigma(i) + call psb_geaxpby(-taum(i,j),rh(i),sone,rh(j),desc_a,info) + enddo + sigma(j) = psb_gedot(rh(j),rh(j),desc_a,info) + gamma1(j) = psb_gedot(rh(0),rh(j),desc_a,info) + gamma1(j) = gamma1(j)/sigma(j) + enddo + + gamma(nl) = gamma1(nl) + omega = gamma(nl) + + do j=nl-1,1,-1 + gamma(j) = gamma1(j) + do i=j+1,nl + gamma(j) = gamma(j) - taum(j,i) * gamma(i) + enddo + enddo + + do j=1,nl-1 + gamma2(j) = gamma(j+1) + do i=j+1,nl-1 + gamma2(j) = gamma2(j) + taum(j,i) * gamma(i+1) + enddo + enddo + + call psb_geaxpby(gamma(1),rh(0),sone,x,desc_a,info) + call psb_geaxpby(-gamma1(nl),rh(nl),sone,rh(0),desc_a,info) + call psb_geaxpby(-gamma(nl),uh(nl),sone,uh(0),desc_a,info) + + do j=1, nl-1 + call psb_geaxpby(-gamma(j),uh(j),sone,uh(0),desc_a,info) + call psb_geaxpby(gamma2(j),rh(j),sone,x,desc_a,info) + call psb_geaxpby(-gamma1(j),rh(j),sone,rh(0),desc_a,info) + enddo + + if (psb_check_conv(methdname,itx,x,rh(0),desc_a,stopdat,info)) exit restart + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + end do iteration + end do restart + + call psb_end_conv(methdname,itx,desc_a,stopdat,info,derr,iter) + if (present(err)) err = derr + + if (info == psb_success_) call psb_gefree(uh,desc_a,info) + if (info == psb_success_) call psb_gefree(rh,desc_a,info) + if (info == psb_success_) call psb_gefree(wwrk,desc_a,info) + if (info == psb_success_) deallocate(aux,stat=info) + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + + ! restore external global coherence behaviour + call psb_restore_coher(ictxt,isvch) + 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 psb_scgstabl_vect + + diff --git a/krylov/psb_skrylov.f90 b/krylov/psb_skrylov.f90 index 927a461cc..68d69a2fe 100644 --- a/krylov/psb_skrylov.f90 +++ b/krylov/psb_skrylov.f90 @@ -245,5 +245,176 @@ Subroutine psb_skrylov(method,a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,i end subroutine psb_skrylov +Subroutine psb_skrylov_vect(method,a,prec,b,x,eps,desc_a,info,& + & itmax,iter,err,itrace,irst,istop,cond) + + use psb_base_mod + use psb_prec_mod,only : psb_sprec_type + use psb_krylov_mod, psb_protect_name => psb_skrylov_vect + + character(len=*) :: method + Type(psb_sspmat_type), Intent(in) :: a + Type(psb_desc_type), Intent(in) :: desc_a + class(psb_sprec_type), intent(inout) :: prec + type(psb_s_vect_type), Intent(inout) :: b + type(psb_s_vect_type), Intent(inout) :: x + Real(psb_spk_), Intent(in) :: eps + integer, intent(out) :: info + Integer, Optional, Intent(in) :: itmax, itrace, irst,istop + Integer, Optional, Intent(out) :: iter + Real(psb_spk_), Optional, Intent(out) :: err,cond + + interface + subroutine psb_scg_vect(a,prec,b,x,eps,& + & desc_a,info,itmax,iter,err,itrace,istop,cond) + use psb_base_mod, only : psb_desc_type, psb_sspmat_type,& + & psb_spk_, psb_s_vect_type + use psb_prec_mod, only : psb_sprec_type + type(psb_sspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + class(psb_sprec_type), intent(inout) :: prec + type(psb_s_vect_type), Intent(inout) :: b + type(psb_s_vect_type), Intent(inout) :: x + real(psb_spk_), intent(in) :: eps + integer, intent(out) :: info + integer, optional, intent(in) :: itmax, itrace,istop + integer, optional, intent(out) :: iter + real(psb_spk_), optional, intent(out) :: err,cond + end subroutine psb_scg_vect + subroutine psb_sbicg_vect(a,prec,b,x,eps,& + & desc_a,info,itmax,iter,err,itrace,istop) + use psb_base_mod, only : psb_desc_type, psb_sspmat_type,& + & psb_spk_, psb_s_vect_type + use psb_prec_mod, only : psb_sprec_type + type(psb_sspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + class(psb_sprec_type), intent(inout) :: prec + type(psb_s_vect_type), Intent(inout) :: b + type(psb_s_vect_type), Intent(inout) :: x + real(psb_spk_), intent(in) :: eps + integer, intent(out) :: info + integer, optional, intent(in) :: itmax, itrace,istop + integer, optional, intent(out) :: iter + real(psb_spk_), optional, intent(out) :: err + end subroutine psb_sbicg_vect + subroutine psb_scgstab_vect(a,prec,b,x,eps,& + & desc_a,info,itmax,iter,err,itrace,istop) + use psb_base_mod, only : psb_desc_type, psb_sspmat_type,& + & psb_spk_, psb_s_vect_type + use psb_prec_mod, only : psb_sprec_type + type(psb_sspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + type(psb_s_vect_type), Intent(inout) :: b + type(psb_s_vect_type), Intent(inout) :: x + real(psb_spk_), intent(in) :: eps + class(psb_sprec_type), intent(inout) :: prec + integer, intent(out) :: info + integer, optional, intent(in) :: itmax, itrace,istop + integer, optional, intent(out) :: iter + real(psb_spk_), optional, intent(out) :: err + end subroutine psb_scgstab_vect + Subroutine psb_scgstabl_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err, itrace,irst,istop) + use psb_base_mod, only : psb_desc_type, psb_sspmat_type, & + & psb_spk_, psb_s_vect_type + use psb_prec_mod, only : psb_sprec_type + Type(psb_sspmat_type), Intent(in) :: a + Type(psb_desc_type), Intent(in) :: desc_a + class(psb_sprec_type), intent(inout) :: prec + type(psb_s_vect_type), Intent(inout) :: b + type(psb_s_vect_type), Intent(inout) :: x + Real(psb_spk_), Intent(in) :: eps + integer, intent(out) :: info + Integer, Optional, Intent(in) :: itmax, itrace, irst,istop + Integer, Optional, Intent(out) :: iter + Real(psb_spk_), Optional, Intent(out) :: err + end subroutine psb_scgstabl_vect + Subroutine psb_srgmres_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err,itrace,irst,istop) + use psb_base_mod, only : psb_desc_type, psb_sspmat_type,& + & psb_spk_, psb_s_vect_type + use psb_prec_mod, only : psb_sprec_type + Type(psb_sspmat_type), Intent(in) :: a + Type(psb_desc_type), Intent(in) :: desc_a + class(psb_sprec_type), intent(inout) :: prec + type(psb_s_vect_type), Intent(inout) :: b + type(psb_s_vect_type), Intent(inout) :: x + Real(psb_spk_), Intent(in) :: eps + integer, intent(out) :: info + Integer, Optional, Intent(in) :: itmax, itrace, irst,istop + Integer, Optional, Intent(out) :: iter + Real(psb_spk_), Optional, Intent(out) :: err + end subroutine psb_srgmres_vect + subroutine psb_scgs_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err,itrace,istop) + use psb_base_mod, only : psb_desc_type, psb_sspmat_type,& + & psb_spk_, psb_s_vect_type + use psb_prec_mod, only : psb_sprec_type + type(psb_sspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + class(psb_sprec_type), intent(inout) :: prec + type(psb_s_vect_type), Intent(inout) :: b + type(psb_s_vect_type), Intent(inout) :: x + real(psb_spk_), intent(in) :: eps + integer, intent(out) :: info + integer, optional, intent(in) :: itmax, itrace,istop + integer, optional, intent(out) :: iter + real(psb_spk_), optional, intent(out) :: err + end subroutine psb_scgs_vect + end interface + integer :: ictxt,me,np,err_act + character(len=20) :: name + + info = psb_success_ + name = 'psb_krylov' + call psb_erractionsave(err_act) + + ictxt=desc_a%get_context() + + call psb_info(ictxt, me, np) + + select case(psb_toupper(method)) + case('CG') + call psb_scg_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err,itrace,istop,cond) + case('CGS') + call psb_scgs_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err,itrace,istop) + case('BICG') + call psb_sbicg_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err,itrace,istop) + case('BICGSTAB') + call psb_scgstab_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err,itrace,istop) + case('RGMRES') + call psb_srgmres_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err,itrace,irst,istop) + case('BICGSTABL') + call psb_scgstabl_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err,itrace,irst,istop) + case default + if (me == 0) write(psb_err_unit,*) trim(name),& + & ': Warning: Unknown method ',method,& + & ', defaulting to BiCGSTAB' + call psb_scgstab_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err,itrace,istop) + end select + + if(info /= psb_success_) 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(ictxt) + return + end if + +end subroutine psb_skrylov_vect diff --git a/krylov/psb_srgmres.f90 b/krylov/psb_srgmres.f90 index c805329e4..97b28ee5b 100644 --- a/krylov/psb_srgmres.f90 +++ b/krylov/psb_srgmres.f90 @@ -109,7 +109,7 @@ subroutine psb_srgmres(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,istop) use psb_base_mod use psb_prec_mod - use psb_inner_krylov_mod + use psb_s_inner_krylov_mod use psb_krylov_mod implicit none @@ -487,3 +487,378 @@ subroutine psb_srgmres(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,ist end subroutine psb_srgmres + +subroutine psb_srgmres_vect(a,prec,b,x,eps,desc_a,info,& + & itmax,iter,err,itrace,irst,istop) + use psb_base_mod + use psb_prec_mod + use psb_s_inner_krylov_mod + use psb_krylov_mod + implicit none + type(psb_sspmat_type), intent(in) :: a + Type(psb_desc_type), Intent(in) :: desc_a + class(psb_sprec_type), intent(inout) :: prec + type(psb_s_vect_type), Intent(inout) :: b + type(psb_s_vect_type), Intent(inout) :: x + Real(psb_spk_), Intent(in) :: eps + integer, intent(out) :: info + Integer, Optional, Intent(in) :: itmax, itrace, irst,istop + Integer, Optional, Intent(out) :: iter + Real(psb_spk_), Optional, Intent(out) :: err +!!$ local data + Real(psb_spk_), allocatable :: aux(:) + Real(psb_spk_), allocatable :: c(:), s(:), h(:,:), rs(:), rst(:) + type(psb_s_vect_type), allocatable :: v(:) + type(psb_s_vect_type) :: w, w1, xt + Real(psb_spk_) :: scal, gm, rti, rti1 + Integer ::litmax, naux, mglob, it,k, itrace_,& + & np,me, n_row, n_col, nl, int_err(5) + Logical, Parameter :: exchange=.True., noexchange=.False., use_srot=.true. + Integer, Parameter :: irmax = 8 + Integer :: itx, i, isvch, ictxt,istop_, err_act + integer :: debug_level, debug_unit + Real(psb_spk_) :: rni, xni, bni, ani,bn2, dt + real(psb_dpk_) :: errnum, errden, deps, derr + character(len=20) :: name + character(len=*), parameter :: methdname='RGMRES' + + info = psb_success_ + name = 'psb_sgmres' + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt = desc_a%get_context() + Call psb_info(ictxt, me, np) + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),': from psb_info',np + if (.not.allocated(b%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + mglob = desc_a%get_global_rows() + n_row = desc_a%get_local_rows() + n_col = desc_a%get_local_cols() + + if (present(istop)) then + istop_ = istop + else + istop_ = 2 + endif +! +! ISTOP_ = 1: Normwise backward error, infinity norm +! ISTOP_ = 2: ||r||/||b||, 2-norm +! + + if ((istop_ < 1 ).or.(istop_ > 2 ) ) then + info=psb_err_invalid_istop_ + int_err(1)=istop_ + err=info + call psb_errpush(info,name,i_err=int_err) + goto 9999 + endif + + if (present(itmax)) then + litmax = itmax + else + litmax = 1000 + endif + + if (present(itrace)) then + itrace_ = itrace + else + itrace_ = 0 + end if + + if (present(irst)) then + nl = irst + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' present: irst: ',irst,nl + else + nl = 10 + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' not present: irst: ',irst,nl + endif + if (nl <=0 ) then + info=psb_err_invalid_istop_ + int_err(1)=nl + err=info + call psb_errpush(info,name,i_err=int_err) + goto 9999 + endif + + call psb_chkvect(mglob,1,x%get_nrows(),1,1,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_chkvect on X') + goto 9999 + end if + call psb_chkvect(mglob,1,b%get_nrows(),1,1,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_chkvect on B') + goto 9999 + end if + + + naux=4*n_col + allocate(aux(naux),h(nl+1,nl+1),& + &c(nl+1),s(nl+1),rs(nl+1), rst(nl+1),stat=info) + + if (info == psb_success_) call psb_geall(v,desc_a,info,n=nl+1) + if (info == psb_success_) call psb_geall(w,desc_a,info) + if (info == psb_success_) call psb_geall(w1,desc_a,info) + if (info == psb_success_) call psb_geall(xt,desc_a,info) + if (info == psb_success_) call psb_geasb(v,desc_a,info,mold=x%v) + if (info == psb_success_) call psb_geasb(w,desc_a,info,mold=x%v) + if (info == psb_success_) call psb_geasb(w1,desc_a,info,mold=x%v) + if (info == psb_success_) call psb_geasb(xt,desc_a,info,mold=x%v) + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' Size of V,W,W1 ',v(1)%get_nrows(),size(v),& + & w%get_nrows(),w1%get_nrows() + + ! Ensure global coherence for convergence checks. + call psb_set_coher(ictxt,isvch) + + if (istop_ == 1) then + ani = psb_spnrmi(a,desc_a,info) + bni = psb_geamax(b,desc_a,info) + else if (istop_ == 2) then + bn2 = psb_genrm2(b,desc_a,info) + endif + errnum = szero + errden = sone + deps = eps + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + if ((itrace_ > 0).and.(me == 0)) call log_header(methdname) + + itx = 0 + restart: do + + ! compute r0 = b-ax0 + ! check convergence + ! compute v1 = r0/||r0||_2 + + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' restart: ',itx,it + it = 0 + call psb_geaxpby(sone,b,szero,v(1),desc_a,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + call psb_spmm(-sone,a,x,sone,v(1),desc_a,info,work=aux) + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + rs(1) = psb_genrm2(v(1),desc_a,info) + rs(2:) = szero + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + scal=sone/rs(1) ! rs(1) MIGHT BE VERY SMALL - USE DSCAL TO DEAL WITH IT? + + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' on entry to amax: b: ',b%get_nrows(),rs(1),scal + + ! + ! check convergence + ! + if (istop_ == 1) then + rni = psb_geamax(v(1),desc_a,info) + xni = psb_geamax(x,desc_a,info) + errnum = rni + errden = (ani*xni+bni) + else if (istop_ == 2) then + rni = psb_genrm2(v(1),desc_a,info) + errnum = rni + errden = bn2 + endif + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + if (errnum <= eps*errden) exit restart + + if (itrace_ > 0) & + & call log_conv(methdname,me,itx,itrace_,errnum,errden,deps) + + call v(1)%scal(scal) !v(1) = v(1) * scal + + if (itx >= litmax) exit restart + + ! + ! inner iterations + ! + + inner: Do i=1,nl + itx = itx + 1 + + call prec%apply(v(i),w1,desc_a,info) + call psb_spmm(sone,a,w1,szero,w,desc_a,info,work=aux) + ! + + do k = 1, i + h(k,i) = psb_gedot(v(k),w,desc_a,info) + call psb_geaxpby(-h(k,i),v(k),sone,w,desc_a,info) + end do + h(i+1,i) = psb_genrm2(w,desc_a,info) + scal=sone/h(i+1,i) + call psb_geaxpby(scal,w,szero,v(i+1),desc_a,info) + do k=2,i + call srot(1,h(k-1,i),1,h(k,i),1,c(k-1),s(k-1)) + enddo + + rti = h(i,i) + rti1 = h(i+1,i) + call srotg(rti,rti1,c(i),s(i)) + call srot(1,h(i,i),1,h(i+1,i),1,c(i),s(i)) + h(i+1,i) = szero + call srot(1,rs(i),1,rs(i+1),1,c(i),s(i)) + + if (istop_ == 1) then + ! + ! build x and then compute the residual and its infinity norm + ! + rst = rs + call w1%set(szero) + call strsm('l','u','n','n',i,1,sone,h,size(h,1),rst,size(rst,1)) + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' Rebuild x-> RS:',rst(1:nl) + do k=1, i + call psb_geaxpby(rst(k),v(k),sone,xt,desc_a,info) + end do + call prec%apply(xt,desc_a,info) + call psb_geaxpby(sone,x,sone,xt,desc_a,info) + call psb_geaxpby(sone,b,szero,w1,desc_a,info) + call psb_spmm(-sone,a,xt,sone,w1,desc_a,info,work=aux) + rni = psb_geamax(w1,desc_a,info) + xni = psb_geamax(xt,desc_a,info) + errnum = rni + errden = (ani*xni+bni) + ! + + else if (istop_ == 2) then + ! + ! compute the residual 2-norm as byproduct of the solution + ! procedure of the least-squares problem + ! + rni = abs(rs(i+1)) + errnum = rni + errden = bn2 + endif + + if (errnum <= eps*errden) then + + if (istop_ == 1) then + call psb_geaxpby(sone,xt,szero,x,desc_a,info) +!!$ x = xt + else if (istop_ == 2) then + ! + ! build x + ! + call strsm('l','u','n','n',i,1,sone,h,size(h,1),rs,size(rs,1)) + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' Rebuild x-> RS:',rs(1:nl) + call w1%set(szero) + do k=1, i + call psb_geaxpby(rs(k),v(k),sone,w1,desc_a,info) + end do + call prec%apply(w1,w,desc_a,info) + call psb_geaxpby(sone,w,sone,x,desc_a,info) + end if + + exit restart + + end if + + if (itrace_ > 0) & + & call log_conv(methdname,me,itx,itrace_,errnum,errden,deps) + + end do inner + + if (istop_ == 1) then + call psb_geaxpby(sone,xt,szero,x,desc_a,info)! x = xt + else if (istop_ == 2) then + ! + ! build x + ! + call strsm('l','u','n','n',nl,1,sone,h,size(h,1),rs,size(rs,1)) + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' Rebuild x-> RS:',rs(1:nl) + call w1%set(szero) + do k=1, nl + call psb_geaxpby(rs(k),v(k),sone,w1,desc_a,info) + end do + call prec%apply(w1,w,desc_a,info) + call psb_geaxpby(sone,w,sone,x,desc_a,info) + end if + + end do restart + if (itrace_ > 0) & + & call log_conv(methdname,me,itx,1,errnum,errden,deps) + + call log_end(methdname,me,itx,errnum,errden,deps,err=derr,iter=iter) + if (present(err)) err = derr + + + if (info == psb_success_) call psb_gefree(v,desc_a,info) + if (info == psb_success_) call psb_gefree(w,desc_a,info) + if (info == psb_success_) call psb_gefree(w1,desc_a,info) + if (info == psb_success_) call psb_gefree(xt,desc_a,info) + if (info == psb_success_) deallocate(aux,h,c,s,rs,rst, stat=info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + ! restore external global coherence behaviour + call psb_restore_coher(ictxt,isvch) + + 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 psb_srgmres_vect + diff --git a/krylov/psb_z_inner_krylov_mod.f90 b/krylov/psb_z_inner_krylov_mod.f90 index 11b9962b1..0902c1328 100644 --- a/krylov/psb_z_inner_krylov_mod.f90 +++ b/krylov/psb_z_inner_krylov_mod.f90 @@ -39,11 +39,11 @@ Module psb_z_inner_krylov_mod use psb_base_inner_krylov_mod interface psb_init_conv - module procedure psb_z_init_conv + module procedure psb_z_init_conv, psb_z_init_conv_vect end interface interface psb_check_conv - module procedure psb_z_check_conv + module procedure psb_z_check_conv, psb_z_check_conv_vect end interface @@ -148,7 +148,8 @@ contains if (info == psb_success_) stopdat%values(psb_ik_xni_) = psb_geamax(x,desc_a,info) stopdat%values(psb_ik_errnum_) = stopdat%values(psb_ik_rni_) stopdat%values(psb_ik_errden_) = & - & (stopdat%values(psb_ik_ani_)*stopdat%values(psb_ik_xni_)+stopdat%values(psb_ik_bni_)) + & (stopdat%values(psb_ik_ani_)*stopdat%values(psb_ik_xni_)& + & +stopdat%values(psb_ik_bni_)) case(2) stopdat%values(psb_ik_rn2_) = psb_genrm2(r,desc_a,info) stopdat%values(psb_ik_errnum_) = stopdat%values(psb_ik_rn2_) @@ -169,7 +170,8 @@ contains psb_z_check_conv = (stopdat%values(psb_ik_errnum_) <= stopdat%values(psb_ik_eps_)) else psb_z_check_conv = & - & (stopdat%values(psb_ik_errnum_) <= stopdat%values(psb_ik_eps_)*stopdat%values(psb_ik_errden_)) + & (stopdat%values(psb_ik_errnum_) <=& + & stopdat%values(psb_ik_eps_)*stopdat%values(psb_ik_errden_)) end if psb_z_check_conv = (psb_z_check_conv.or.(stopdat%controls(psb_ik_itmax_) <= it)) @@ -193,4 +195,150 @@ contains end function psb_z_check_conv + subroutine psb_z_init_conv_vect(methdname,stopc,trace,itmax,a,b,eps,desc_a,stopdat,info) + use psb_base_mod + implicit none + character(len=*), intent(in) :: methdname + integer, intent(in) :: stopc, trace,itmax + type(psb_zspmat_type), intent(in) :: a + real(psb_dpk_), intent(in) :: eps + type(psb_z_vect_type), intent(inout) :: b + type(psb_desc_type), intent(in) :: desc_a + type(psb_itconv_type) :: stopdat + integer, intent(out) :: info + + integer :: ictxt, me, np, err_act + character(len=20) :: name + + info = psb_success_ + name = 'psb_init_conv' + call psb_erractionsave(err_act) + + + ictxt=desc_a%get_context() + + call psb_info(ictxt, me, np) + + stopdat%controls(:) = 0 + stopdat%values(:) = szero + + stopdat%controls(psb_ik_stopc_) = stopc + stopdat%controls(psb_ik_trace_) = trace + stopdat%controls(psb_ik_itmax_) = itmax + + select case(stopdat%controls(psb_ik_stopc_)) + case (1) + stopdat%values(psb_ik_ani_) = psb_spnrmi(a,desc_a,info) + if (info == psb_success_)& + & stopdat%values(psb_ik_bni_) = psb_geamax(b,desc_a,info) + + case (2) + stopdat%values(psb_ik_bn2_) = psb_genrm2(b,desc_a,info) + + case default + info=psb_err_invalid_istop_ + call psb_errpush(info,name,i_err=(/stopc,0,0,0,0/)) + goto 9999 + end select + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,a_err="Init conv check data") + goto 9999 + end if + + stopdat%values(psb_ik_eps_) = eps + stopdat%values(psb_ik_errnum_) = szero + stopdat%values(psb_ik_errden_) = done + + if ((stopdat%controls(psb_ik_trace_) > 0).and. (me == 0))& + & call log_header(methdname) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + + end subroutine psb_z_init_conv_vect + + function psb_z_check_conv_vect(methdname,it,x,r,desc_a,stopdat,info) result(res) + use psb_base_mod + implicit none + character(len=*), intent(in) :: methdname + integer, intent(in) :: it + type(psb_z_vect_type), intent(inout) :: x, r + type(psb_desc_type), intent(in) :: desc_a + type(psb_itconv_type) :: stopdat + logical :: res + integer, intent(out) :: info + + integer :: ictxt, me, np, err_act + character(len=20) :: name + + info = psb_success_ + res = .false. + if (psb_errstatus_fatal()) return + name = 'psb_zheck_conv' + call psb_erractionsave(err_act) + + ictxt = desc_a%get_context() + call psb_info(ictxt,me,np) + + + + select case(stopdat%controls(psb_ik_stopc_)) + case(1) + stopdat%values(psb_ik_rni_) = psb_geamax(r,desc_a,info) + if (info == psb_success_) stopdat%values(psb_ik_xni_) = psb_geamax(x,desc_a,info) + stopdat%values(psb_ik_errnum_) = stopdat%values(psb_ik_rni_) + stopdat%values(psb_ik_errden_) = & + & (stopdat%values(psb_ik_ani_)*stopdat%values(psb_ik_xni_)& + & +stopdat%values(psb_ik_bni_)) + case(2) + stopdat%values(psb_ik_rn2_) = psb_genrm2(r,desc_a,info) + stopdat%values(psb_ik_errnum_) = stopdat%values(psb_ik_rn2_) + stopdat%values(psb_ik_errden_) = stopdat%values(psb_ik_bn2_) + + case default + info=psb_err_internal_error_ + call psb_errpush(info,name,a_err="Control data in stopdat messed up!") + goto 9999 + end select + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + if (stopdat%values(psb_ik_errden_) == dzero) then + res = (stopdat%values(psb_ik_errnum_) <= stopdat%values(psb_ik_eps_)) + else + res = (stopdat%values(psb_ik_errnum_) <=& + & stopdat%values(psb_ik_eps_)*stopdat%values(psb_ik_errden_)) + end if + + res = (res.or.(stopdat%controls(psb_ik_itmax_) <= it)) + + if ( (stopdat%controls(psb_ik_trace_) > 0).and.& + & ((mod(it,stopdat%controls(psb_ik_trace_)) == 0).or.res)) then + call log_conv(methdname,me,it,1,stopdat%values(psb_ik_errnum_),& + & stopdat%values(psb_ik_errden_),stopdat%values(psb_ik_eps_)) + 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(ictxt) + return + end if + + end function psb_z_check_conv_vect + + end module psb_z_inner_krylov_mod diff --git a/krylov/psb_zbicg.f90 b/krylov/psb_zbicg.f90 index c95405382..a487ac5f3 100644 --- a/krylov/psb_zbicg.f90 +++ b/krylov/psb_zbicg.f90 @@ -96,7 +96,7 @@ subroutine psb_zbicg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) use psb_base_mod use psb_prec_mod - use psb_inner_krylov_mod + use psb_z_inner_krylov_mod use psb_krylov_mod implicit none @@ -330,3 +330,252 @@ subroutine psb_zbicg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) end subroutine psb_zbicg +subroutine psb_zbicg_vect(a,prec,b,x,eps,desc_a,info,& + & itmax,iter,err,itrace,istop) + use psb_base_mod + use psb_prec_mod + use psb_z_inner_krylov_mod + use psb_krylov_mod + implicit none + type(psb_zspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + class(psb_zprec_type), intent(inout) :: prec + type(psb_z_vect_type), Intent(inout) :: b + type(psb_z_vect_type), Intent(inout) :: x + real(psb_dpk_), intent(in) :: eps + integer, intent(out) :: info + integer, optional, intent(in) :: itmax, itrace, istop + integer, optional, intent(out) :: iter + real(psb_dpk_), optional, intent(out) :: err +!!$ local data + complex(psb_dpk_), allocatable, target :: aux(:) + type(psb_z_vect_type), allocatable, target :: wwrk(:) + type(psb_z_vect_type), pointer :: ww, q, r, p,& + & zt, pt, z, rt, qt + integer :: int_err(5) + integer :: itmax_, naux, mglob, it, itrace_,& + & np,me, n_row, n_col, istop_, err_act + integer :: debug_level, debug_unit + logical, parameter :: exchange=.true., noexchange=.false. + integer, parameter :: irmax = 8 + integer :: itx, isvch, ictxt + complex(psb_dpk_) :: alpha, beta, rho, rho_old, sigma + real(psb_dpk_) :: derr + type(psb_itconv_type) :: stopdat + character(len=20) :: name,ch_err + character(len=*), parameter :: methdname='BiCG' + + info = psb_success_ + name = 'psb_bicg' + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt = desc_a%get_context() + call psb_info(ictxt, me, np) + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),': from psb_info',np + + mglob = desc_a%get_global_rows() + n_row = desc_a%get_local_rows() + n_col = desc_a%get_local_cols() + + ! Ensure global coherence for convergence checks. + call psb_set_coher(ictxt,isvch) + + if (.not.allocated(b%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + if (present(istop)) then + istop_ = istop + else + istop_ = 2 + endif + ! + ! istop_ = 1: normwise backward error, infinity norm + ! istop_ = 2: ||r||/||b|| norm 2 + ! + + if ((istop_ < 1 ).or.(istop_ > 2 ) ) then + info=psb_err_invalid_istop_ + int_err=istop_ + err=info + call psb_errpush(info,name,i_err=int_err) + goto 9999 + endif + + call psb_chkvect(mglob,1,x%get_nrows(),1,1,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_chkvect on X') + goto 9999 + end if + call psb_chkvect(mglob,1,b%get_nrows(),1,1,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_chkvect on B') + goto 9999 + end if + + + naux=4*n_col + + allocate(aux(naux),stat=info) + if (info == psb_success_) call psb_geall(wwrk,desc_a,info,n=9) + if (info == psb_success_) call psb_geasb(wwrk,desc_a,info,mold=x%v) + if(info /= psb_success_) then + info=psb_err_from_subroutine_non_ + ch_err='psb_asb' + err=info + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + q => wwrk(1) + qt => wwrk(2) + r => wwrk(3) + rt => wwrk(4) + p => wwrk(5) + pt => wwrk(6) + z => wwrk(7) + zt => wwrk(8) + ww => wwrk(9) + + if (present(itmax)) then + itmax_ = itmax + else + itmax_ = 1000 + endif + + if (present(itrace)) then + itrace_ = itrace + else + itrace_ = 0 + end if + + itx = 0 + + + call psb_init_conv(methdname,istop_,itrace_,itmax_,a,b,eps,desc_a,stopdat,info) + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + restart: do +!!$ +!!$ r0 = b-ax0 +!!$ + if (itx >= itmax_) exit restart + it = 0 + call psb_geaxpby(zone,b,zzero,r,desc_a,info) + if (info == psb_success_) call psb_spmm(-zone,a,x,zone,r,desc_a,info,work=aux) + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),' Done spmm',info + if (info == psb_success_) call psb_geaxpby(zone,r,zzero,rt,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + rho = zzero + + ! Perhaps we already satisfy the convergence criterion... + if (psb_check_conv(methdname,itx,x,r,desc_a,stopdat,info)) exit restart + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + iteration: do + it = it + 1 + itx = itx + 1 + + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),'iteration: ',itx + + call prec%apply(r,z,desc_a,info,work=aux) + if (info == psb_success_) call prec%apply(rt,zt,desc_a,info,trans='c',work=aux) + + rho_old = rho + rho = psb_gedot(rt,z,desc_a,info) + if (rho == zzero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' iteration breakdown r',rho + exit iteration + endif + + if (it == 1) then + call psb_geaxpby(zone,z,zzero,p,desc_a,info) + call psb_geaxpby(zone,zt,zzero,pt,desc_a,info) + else + beta = (rho/rho_old) + call psb_geaxpby(zone,z,beta,p,desc_a,info) + call psb_geaxpby(zone,zt,beta,pt,desc_a,info) + end if + + call psb_spmm(zone,a,p,zzero,q,desc_a,info,& + & work=aux) + call psb_spmm(zone,a,pt,zzero,qt,desc_a,info,& + & work=aux,trans='c') + + sigma = psb_gedot(pt,q,desc_a,info) + if (sigma == zzero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' iteration breakdown s1', sigma + exit iteration + endif + + alpha = rho/sigma + + + call psb_geaxpby(alpha,p,zone,x,desc_a,info) + call psb_geaxpby(-alpha,q,zone,r,desc_a,info) + call psb_geaxpby(-alpha,qt,zone,rt,desc_a,info) + + if (psb_check_conv(methdname,itx,x,r,desc_a,stopdat,info)) exit restart + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + end do iteration + end do restart + + call psb_end_conv(methdname,itx,desc_a,stopdat,info,derr,iter) + if (present(err)) err = derr + + if (info == psb_success_) call psb_gefree(wwrk,desc_a,info) + if (info == psb_success_) deallocate(aux,stat=info) + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + ! restore external global coherence behaviour + call psb_restore_coher(ictxt,isvch) + + 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 psb_zbicg_vect + + diff --git a/krylov/psb_zcg.F90 b/krylov/psb_zcg.F90 index 239c1d299..e59c16d1c 100644 --- a/krylov/psb_zcg.F90 +++ b/krylov/psb_zcg.F90 @@ -98,7 +98,7 @@ subroutine psb_zcg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) use psb_base_mod use psb_prec_mod - use psb_inner_krylov_mod + use psb_z_inner_krylov_mod use psb_krylov_mod implicit none @@ -279,3 +279,204 @@ subroutine psb_zcg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) end subroutine psb_zcg + +subroutine psb_zcg_vect(a,prec,b,x,eps,desc_a,info,& + & itmax,iter,err,itrace,istop) + use psb_base_mod + use psb_prec_mod + use psb_z_inner_krylov_mod + use psb_krylov_mod + implicit none + type(psb_zspmat_type), intent(in) :: a + Type(psb_desc_type), Intent(in) :: desc_a + class(psb_zprec_type), intent(inout) :: prec + type(psb_z_vect_type), Intent(inout) :: b + type(psb_z_vect_type), Intent(inout) :: x + Real(psb_dpk_), Intent(in) :: eps + integer, intent(out) :: info + Integer, Optional, Intent(in) :: itmax, itrace, istop + Integer, Optional, Intent(out) :: iter + Real(psb_dpk_), Optional, Intent(out) :: err +!!$ Local data + complex(psb_dpk_), allocatable, target :: aux(:) + type(psb_z_vect_type), allocatable, target :: wwrk(:) + type(psb_z_vect_type), pointer :: q, p, r, z, w + complex(psb_dpk_) :: alpha, beta, rho, rho_old, sigma,alpha_old,beta_old + integer :: itmax_, istop_, naux, mglob, it, itx, itrace_,& + & np,me, n_col, isvch, ictxt, n_row,err_act, int_err(5), ieg,nspl, istebz + integer :: debug_level, debug_unit + real(psb_dpk_) :: derr + type(psb_itconv_type) :: stopdat + character(len=20) :: name + character(len=*), parameter :: methdname='CG' + + info = psb_success_ + name = 'psb_zcg' + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt = desc_a%get_context() + + call psb_info(ictxt, me, np) + if (.not.allocated(b%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + mglob = desc_a%get_global_rows() + n_row = desc_a%get_local_rows() + n_col = desc_a%get_local_cols() + + + if (present(istop)) then + istop_ = istop + else + istop_ = 2 + endif + + call psb_chkvect(mglob,1,x%get_nrows(),1,1,desc_a,info) + if (info == psb_success_)& + & call psb_chkvect(mglob,1,b%get_nrows(),1,1,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_chkvect on X/B') + goto 9999 + end if + + naux=4*n_col + allocate(aux(naux), stat=info) + if (info == psb_success_) call psb_geall(wwrk,desc_a,info,n=5) + if (info == psb_success_) call psb_geasb(wwrk,desc_a,info,mold=x%v) + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + p => wwrk(1) + q => wwrk(2) + r => wwrk(3) + z => wwrk(4) + w => wwrk(5) + + + if (present(itmax)) then + itmax_ = itmax + else + itmax_ = 1000 + endif + + if (present(itrace)) then + itrace_ = itrace + else + itrace_ = 0 + end if + + + itx=0 + + ! Ensure global coherence for convergence checks. + call psb_set_coher(ictxt,isvch) + + restart: do +!!$ +!!$ r0 = b-Ax0 +!!$ + if (itx>= itmax_) exit restart + + it = 0 + call psb_geaxpby(zone,b,zzero,r,desc_a,info) + if (info == psb_success_) call psb_spmm(-zone,a,x,zone,r,desc_a,info,work=aux) + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + rho = zzero + + call psb_init_conv(methdname,istop_,itrace_,itmax_,a,b,eps,desc_a,stopdat,info) + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + iteration: do + + it = it + 1 + itx = itx + 1 + + call prec%apply(r,z,desc_a,info,work=aux) + rho_old = rho + rho = psb_gedot(r,z,desc_a,info) + + if (it == 1) then + call psb_geaxpby(zone,z,zzero,p,desc_a,info) + else + if (rho_old == zzero) then + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),& + & ': CG Iteration breakdown rho' + exit iteration + endif + beta = rho/rho_old + call psb_geaxpby(zone,z,beta,p,desc_a,info) + end if + + call psb_spmm(zone,a,p,zzero,q,desc_a,info,work=aux) + sigma = psb_gedot(p,q,desc_a,info) + if (sigma == zzero) then + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),& + & ': CG Iteration breakdown sigma' + exit iteration + endif + alpha_old = alpha + alpha = rho/sigma + + call psb_geaxpby(alpha,p,zone,x,desc_a,info) + call psb_geaxpby(-alpha,q,zone,r,desc_a,info) + + if (psb_check_conv(methdname,itx,x,r,desc_a,stopdat,info)) exit restart + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + end do iteration + end do restart + + call psb_end_conv(methdname,itx,desc_a,stopdat,info,derr,iter) + if (present(err)) err = derr + + if (info == psb_success_) call psb_gefree(wwrk,desc_a,info) + if (info == psb_success_) deallocate(aux,stat=info) + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + + ! restore external global coherence behaviour + call psb_restore_coher(ictxt,isvch) + + 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 psb_zcg_vect + diff --git a/krylov/psb_zcgs.f90 b/krylov/psb_zcgs.f90 index d4e2746c9..b1248a2c4 100644 --- a/krylov/psb_zcgs.f90 +++ b/krylov/psb_zcgs.f90 @@ -95,7 +95,7 @@ Subroutine psb_zcgs(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) use psb_base_mod use psb_prec_mod - use psb_inner_krylov_mod + use psb_z_inner_krylov_mod use psb_krylov_mod implicit none @@ -321,3 +321,245 @@ Subroutine psb_zcgs(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) return end subroutine psb_zcgs + +Subroutine psb_zcgs_vect(a,prec,b,x,eps,desc_a,info,& + & itmax,iter,err,itrace,istop) + use psb_base_mod + use psb_prec_mod + use psb_z_inner_krylov_mod + use psb_krylov_mod + implicit none + type(psb_zspmat_type), intent(in) :: a + Type(psb_desc_type), Intent(in) :: desc_a + class(psb_zprec_type), intent(inout) :: prec + type(psb_z_vect_type), Intent(inout) :: b + type(psb_z_vect_type), Intent(inout) :: x + Real(psb_dpk_), Intent(in) :: eps + integer, intent(out) :: info + Integer, Optional, Intent(in) :: itmax, itrace,istop + Integer, Optional, Intent(out) :: iter + Real(psb_dpk_), Optional, Intent(out) :: err +!!$ local data + complex(psb_dpk_), allocatable, target :: aux(:) + type(psb_z_vect_type), allocatable, target :: wwrk(:) + type(psb_z_vect_type), pointer :: ww, q, r, p, v,& + & s, z, f, rt, qt, uv + Integer :: itmax_, naux, mglob, it, itrace_,int_err(5),& + & np,me, n_row, n_col,istop_, err_act + Integer :: itx, isvch, ictxt + integer :: debug_level, debug_unit + complex(psb_dpk_) :: alpha, beta, rho, rho_old, sigma + real(psb_dpk_) :: derr + type(psb_itconv_type) :: stopdat + character(len=20) :: name + character(len=*), parameter :: methdname='CGS' + + info = psb_success_ + name = 'psb_zcgs' + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt = desc_a%get_context() + Call psb_info(ictxt, me, np) + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),': from psb_info',np + if (.not.allocated(b%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + mglob = desc_a%get_global_rows() + n_row = desc_a%get_local_rows() + n_col = desc_a%get_local_cols() + + If (Present(istop)) Then + istop_ = istop + Else + istop_ = 2 + Endif + + call psb_chkvect(mglob,1,x%get_nrows(),1,1,desc_a,info) + if (info == psb_success_) call psb_chkvect(mglob,1,b%get_nrows(),1,1,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_chkvect on X/B') + goto 9999 + end if + + naux=4*n_col + Allocate(aux(naux),stat=info) + if (info == psb_success_) Call psb_geall(wwrk,desc_a,info,n=11) + if (info == psb_success_) Call psb_geasb(wwrk,desc_a,info,mold=x%v) + if (info /= psb_success_) Then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + End If + + q => wwrk(1) + qt => wwrk(2) + r => wwrk(3) + rt => wwrk(4) + p => wwrk(5) + v => wwrk(6) + uv => wwrk(7) + z => wwrk(8) + f => wwrk(9) + s => wwrk(10) + ww => wwrk(11) + + + If (Present(itmax)) Then + itmax_ = itmax + Else + itmax_ = 1000 + Endif + + If (Present(itrace)) Then + itrace_ = itrace + Else + itrace_ = 0 + End If + + ! Ensure global coherence for convergence checks. + call psb_set_coher(ictxt,isvch) + + itx = 0 + + call psb_init_conv(methdname,istop_,itrace_,itmax_,a,b,eps,desc_a,stopdat,info) + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + restart: Do +!!$ +!!$ r0 = b-ax0 +!!$ + if (itx >= itmax_) exit restart + it = 0 + call psb_geaxpby(zone,b,zzero,r,desc_a,info) + if (info == psb_success_) call psb_spmm(-zone,a,x,zone,r,desc_a,info,work=aux) + if (info == psb_success_) call psb_geaxpby(zone,r,zzero,rt,desc_a,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + + ! Perhaps we already satisfy the convergence criterion... + if (psb_check_conv(methdname,itx,x,r,desc_a,stopdat,info)) exit restart + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + rho = zzero + + iteration: do + it = it + 1 + itx = itx + 1 + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),'iteration: ',itx + + rho_old = rho + rho = psb_gedot(rt,r,desc_a,info) + + if (rho == zzero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' iteration breakdown r',rho + exit iteration + endif + + if (it == 1) then + call psb_geaxpby(zone,r,zzero,uv,desc_a,info) + if (info == psb_success_) call psb_geaxpby(zone,r,zzero,p,desc_a,info) + else + beta = (rho/rho_old) + call psb_geaxpby(zone,r,zzero,uv,desc_a,info) + if (info == psb_success_) call psb_geaxpby(beta,q,zone,uv,desc_a,info) + if (info == psb_success_) call psb_geaxpby(zone,q,beta,p,desc_a,info) + if (info == psb_success_) call psb_geaxpby(zone,uv,beta,p,desc_a,info) + end if + + if (info == psb_success_) call prec%apply(p,f,desc_a,info,work=aux) + + if (info == psb_success_) call psb_spmm(zone,a,f,zzero,v,desc_a,info,& + & work=aux) + + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='First loop part ') + goto 9999 + end if + + sigma = psb_gedot(rt,v,desc_a,info) + if (sigma == zzero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' iteration breakdown s1', sigma + exit iteration + endif + + alpha = rho/sigma + + if (info == psb_success_) call psb_geaxpby(zone,uv,zzero,q,desc_a,info) + if (info == psb_success_) call psb_geaxpby(-alpha,v,zone,q,desc_a,info) + if (info == psb_success_) call psb_geaxpby(zone,uv,zzero,s,desc_a,info) + if (info == psb_success_) call psb_geaxpby(zone,q,zone,s,desc_a,info) + + if (info == psb_success_) call prec%apply(s,z,desc_a,info,work=aux) + + if (info == psb_success_) call psb_geaxpby(alpha,z,zone,x,desc_a,info) + + if (info == psb_success_) call psb_spmm(zone,a,z,zzero,qt,desc_a,info,& + & work=aux) + + if (info == psb_success_) call psb_geaxpby(-alpha,qt,zone,r,desc_a,info) + + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='X update ') + goto 9999 + end if + + if (psb_check_conv(methdname,itx,x,r,desc_a,stopdat,info)) exit restart + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + end do iteration + end do restart + + call psb_end_conv(methdname,itx,desc_a,stopdat,info,derr,iter) + if (present(err)) err = derr + + if (info == psb_success_) call psb_gefree(wwrk,desc_a,info) + if (info == psb_success_) deallocate(aux,stat=info) + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + + ! restore external global coherence behaviour + call psb_restore_coher(ictxt,isvch) + 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 psb_zcgs_vect diff --git a/krylov/psb_zcgstab.f90 b/krylov/psb_zcgstab.f90 index 743db7f7e..6104be4c8 100644 --- a/krylov/psb_zcgstab.f90 +++ b/krylov/psb_zcgstab.f90 @@ -96,7 +96,7 @@ subroutine psb_zcgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) use psb_base_mod use psb_prec_mod - use psb_inner_krylov_mod + use psb_z_inner_krylov_mod use psb_krylov_mod Implicit None !!$ parameters @@ -351,3 +351,318 @@ subroutine psb_zcgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) End Subroutine psb_zcgstab + +Subroutine psb_zcgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) + use psb_base_mod + use psb_prec_mod + use psb_z_inner_krylov_mod + use psb_krylov_mod + implicit none + type(psb_zspmat_type), intent(in) :: a + class(psb_zprec_type), Intent(inout) :: prec + Type(psb_desc_type), Intent(in) :: desc_a + type(psb_z_vect_type), Intent(inout) :: b + type(psb_z_vect_type), Intent(inout) :: x + Real(psb_dpk_), Intent(in) :: eps + integer, intent(out) :: info + Integer, Optional, Intent(in) :: itmax, itrace, istop + Integer, Optional, Intent(out) :: iter + Real(psb_dpk_), Optional, Intent(out) :: err +!!$ Local data + complex(psb_dpk_), allocatable, target :: aux(:),wwrk(:,:) + type(psb_z_vect_type) :: q, r, p, v, s, t, z, f + + Integer :: itmax_, naux, mglob, it,itrace_,& + & np,me, n_row, n_col + integer :: debug_level, debug_unit + Logical, Parameter :: exchange=.True., noexchange=.False., debug1 = .False. + Integer, Parameter :: irmax = 8 + Integer :: itx, isvch, ictxt, err_act, i + Integer :: istop_ + real(psb_dpk_) :: derr + complex(psb_dpk_) :: alpha, beta, rho, rho_old, sigma, omega, tau + type(psb_itconv_type) :: stopdat + + character(len=20) :: name + character(len=*), parameter :: methdname='BiCGStab' + + info = psb_success_ + name = 'psb_scgstab' + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + ictxt = desc_a%get_context() + call psb_info(ictxt, me, np) + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),': from psb_info',np + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(b%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + mglob = desc_a%get_global_rows() + n_row = desc_a%get_local_rows() + n_col = desc_a%get_local_cols() + + If (Present(istop)) Then + istop_ = istop + Else + istop_ = 2 + Endif + ! + ! ISTOP_ = 1: Normwise backward error, infinity norm + ! ISTOP_ = 2: ||r||/||b|| norm 2 + ! +!!$ if (.not.same_type_as(x,b)) then +!!$ write(0,*) 'Warning: different dynamic types for X and B ' +!!$ end if + + call psb_chkvect(mglob,1,x%get_nrows(),1,1,desc_a,info) + if (psb_errstatus_fatal()) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_chkvect on X') + goto 9999 + end if + call psb_chkvect(mglob,1,b%get_nrows(),1,1,desc_a,info) + if (psb_errstatus_fatal()) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_chkvect on B') + goto 9999 + end if + naux=6*n_col + if (info == psb_success_) allocate(aux(naux),stat=info) + if (info /= psb_success_) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + End If + + + call psb_geall(q,desc_a,info) + call psb_geall(r,desc_a,info) + call psb_geall(p,desc_a,info) + call psb_geall(v,desc_a,info) + call psb_geall(s,desc_a,info) + call psb_geall(t,desc_a,info) + call psb_geall(z,desc_a,info) + call psb_geall(f,desc_a,info) + + call psb_geasb(q,desc_a,info,mold=x%v) + call psb_geasb(r,desc_a,info,mold=x%v) + call psb_geasb(p,desc_a,info,mold=x%v) + call psb_geasb(v,desc_a,info,mold=x%v) + call psb_geasb(s,desc_a,info,mold=x%v) + call psb_geasb(t,desc_a,info,mold=x%v) + call psb_geasb(z,desc_a,info,mold=x%v) + call psb_geasb(f,desc_a,info,mold=x%v) + + + if (psb_errstatus_fatal()) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + End If + + If (Present(itmax)) Then + itmax_ = itmax + Else + itmax_ = 1000 + Endif + + If (Present(itrace)) Then + itrace_ = itrace + Else + itrace_ = 0 + End If + + ! Ensure global coherence for convergence checks. + call psb_set_coher(ictxt,isvch) + + itx = 0 + call psb_init_conv(methdname,istop_,itrace_,itmax_,a,b,eps,desc_a,stopdat,info) + if (psb_errstatus_fatal()) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + restart: Do + + if (itx >= itmax_) exit restart + + it = 0 + call psb_geaxpby(zone,b,zzero,r,desc_a,info) + + call psb_spmm(-zone,a,x,zone,r,desc_a,info,work=aux) + call psb_geaxpby(zone,r,zzero,q,desc_a,info) + + ! Perhaps we already satisfy the convergence criterion... + if (psb_check_conv(methdname,itx,x,r,desc_a,stopdat,info)) exit restart + + if (psb_errstatus_fatal()) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='Init residual chk') + goto 9999 + end if + + + rho = zzero + + iteration: Do + it = it + 1 + itx = itx + 1 + + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),& + & ' Iteration: ',itx + + rho_old = rho + rho = psb_gedot(q,r,desc_a,info) + + if (debug_level >= psb_debug_ext_) then + call q%sync() + call r%sync() + end if + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),& + & ' Rho: ',rho + + if (rho == zzero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' Iteration breakdown R',rho + exit iteration + endif + + if (it == 1) then + call psb_geaxpby(zone,r,zzero,p,desc_a,info) + else + beta = (rho/rho_old)*(alpha/omega) + call psb_geaxpby(-omega,v,zone,p,desc_a,info) + call psb_geaxpby(zone,r,beta,p,desc_a,info) + End If + + call prec%apply(p,f,desc_a,info,work=aux) + + call psb_spmm(zone,a,f,zzero,v,desc_a,info,& + & work=aux) + + + sigma = psb_gedot(q,v,desc_a,info) + + if (debug_level >= psb_debug_ext_) then + call q%sync() + call v%sync() + end if + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),& + & ' Sigma: ',sigma + + if (sigma == zzero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' Iteration breakdown S1', sigma + exit iteration + endif + + alpha = rho/sigma + call psb_geaxpby(zone,r,zzero,s,desc_a,info) + call psb_geaxpby(-alpha,v,zone,s,desc_a,info) + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),& + & ' alpha: ',alpha + + + if (psb_errstatus_fatal()) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_geaxpby') + goto 9999 + end if + + + call prec%apply(s,z,desc_a,info,work=aux) + Call psb_spmm(zone,a,z,zzero,t,desc_a,info,work=aux) + + if(psb_errstatus_fatal()) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='precaply/spmm') + goto 9999 + end if + + sigma = psb_gedot(t,t,desc_a,info) + if (sigma == zzero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' Iteration breakdown S2', sigma + exit iteration + endif + + tau = psb_gedot(t,s,desc_a,info) + omega = tau/sigma + + if (debug_level >= psb_debug_ext_) then + call t%sync() + call s%sync() + end if + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),& + & ' sigma, tau, omega: ',sigma, tau, omega + + if (omega == zzero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' Iteration breakdown O',omega + exit iteration + endif + + call psb_geaxpby(alpha,f,zone,x,desc_a,info) + call psb_geaxpby(omega,z,zone,x,desc_a,info) + call psb_geaxpby(zone,s,zzero,r,desc_a,info) + call psb_geaxpby(-omega,t,zone,r,desc_a,info) + if (psb_check_conv(methdname,itx,x,r,desc_a,stopdat,info)) exit restart + + if (psb_errstatus_fatal()) Then + call psb_errpush(psb_err_from_subroutine_,name,a_err='X/R update ') + goto 9999 + End If + + end do iteration + end do restart + + call psb_end_conv(methdname,itx,desc_a,stopdat,info,derr,iter) + if (present(err)) err = derr + + deallocate(aux,stat=info) + + call x%sync() + call psb_gefree(q,desc_a,info) + call psb_gefree(r,desc_a,info) + call psb_gefree(p,desc_a,info) + call psb_gefree(v,desc_a,info) + call psb_gefree(s,desc_a,info) + call psb_gefree(t,desc_a,info) + call psb_gefree(z,desc_a,info) + call psb_gefree(f,desc_a,info) + + if(psb_errstatus_fatal()) then + call psb_errpush(info,name) + goto 9999 + end if + ! restore external global coherence behaviour + call psb_restore_coher(ictxt,isvch) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +End Subroutine psb_zcgstab_vect diff --git a/krylov/psb_zcgstabl.f90 b/krylov/psb_zcgstabl.f90 index 06374e182..991cba4ca 100644 --- a/krylov/psb_zcgstabl.f90 +++ b/krylov/psb_zcgstabl.f90 @@ -106,7 +106,7 @@ Subroutine psb_zcgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,istop) use psb_base_mod use psb_prec_mod - use psb_inner_krylov_mod + use psb_z_inner_krylov_mod use psb_krylov_mod implicit none @@ -407,3 +407,328 @@ Subroutine psb_zcgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,is End Subroutine psb_zcgstabl + +Subroutine psb_zcgstabl_vect(a,prec,b,x,eps,desc_a,info,& + & itmax,iter,err,itrace,irst,istop) + use psb_base_mod + use psb_prec_mod + use psb_z_inner_krylov_mod + use psb_krylov_mod + implicit none + type(psb_zspmat_type), intent(in) :: a + class(psb_zprec_type), Intent(inout) :: prec + Type(psb_desc_type), Intent(in) :: desc_a + type(psb_z_vect_type), Intent(inout) :: b + type(psb_z_vect_type), Intent(inout) :: x + Real(psb_dpk_), Intent(in) :: eps + integer, intent(out) :: info + Integer, Optional, Intent(in) :: itmax, itrace, irst,istop + Integer, Optional, Intent(out) :: iter + Real(psb_dpk_), Optional, Intent(out) :: err +!!$ local data + complex(psb_dpk_), allocatable, target :: aux(:), gamma(:),& + & gamma1(:), gamma2(:), taum(:,:), sigma(:) + type(psb_z_vect_type), allocatable, target :: wwrk(:),uh(:), rh(:) + type(psb_z_vect_type), Pointer :: ww, q, r, rt0, p, v, & + & s, t, z, f + + Integer :: itmax_, naux, mglob, it, itrace_,& + & np,me, n_row, n_col, nl, err_act + Logical, Parameter :: exchange=.True., noexchange=.False. + Integer, Parameter :: irmax = 8 + Integer :: itx, i, isvch, ictxt,istop_,j, k, int_err(5) + integer :: debug_level, debug_unit + complex(psb_dpk_) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,& + & omega + real(psb_dpk_) :: derr + type(psb_itconv_type) :: stopdat + character(len=20) :: name + character(len=*), parameter :: methdname='BiCGStab(L)' + + info = psb_success_ + name = 'psb_zcgstabl' + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt = desc_a%get_context() + Call psb_info(ictxt, me, np) + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),': from psb_info',np + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(b%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + + mglob = desc_a%get_global_rows() + n_row = desc_a%get_local_rows() + n_col = desc_a%get_local_cols() + + if (present(istop)) then + istop_ = istop + else + istop_ = 2 + endif + + if (present(itmax)) then + itmax_ = itmax + else + itmax_ = 1000 + endif + + if (present(itrace)) then + itrace_ = itrace + else + itrace_ = 0 + end if + + if (present(irst)) then + nl = irst + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & 'present: irst: ',irst,nl + else + nl = 1 + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' not present: irst: ',irst,nl + endif + if (nl <=0 ) then + info=psb_err_invalid_istop_ + int_err(1)=nl + err=info + call psb_errpush(info,name,i_err=int_err) + goto 9999 + endif + + call psb_chkvect(mglob,1,x%get_nrows(),1,1,desc_a,info) + if (info == psb_success_) call psb_chkvect(mglob,1,b%get_nrows(),1,1,desc_a,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_chkvect on X/B') + goto 9999 + end if + + naux=4*n_col + allocate(aux(naux),gamma(0:nl),gamma1(nl),& + &gamma2(nl),taum(nl,nl),sigma(nl), stat=info) + + if (info /= psb_success_) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + end if + if (info == psb_success_) Call psb_geall(wwrk,desc_a,info,n=10) + if (info == psb_success_) Call psb_geall(uh,desc_a,info,n=nl+1,lb=0) + if (info == psb_success_) Call psb_geall(rh,desc_a,info,n=nl+1,lb=0) + if (info == psb_success_) Call psb_geasb(wwrk,desc_a,info,mold=x%v) + if (info == psb_success_) Call psb_geasb(uh,desc_a,info,mold=x%v) + if (info == psb_success_) Call psb_geasb(rh,desc_a,info,mold=x%v) + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + q => wwrk(1) + r => wwrk(2) + p => wwrk(3) + v => wwrk(4) + f => wwrk(5) + s => wwrk(6) + t => wwrk(7) + z => wwrk(8) + ww => wwrk(9) + rt0 => wwrk(10) + + ! Ensure global coherence for convergence checks. + call psb_set_coher(ictxt,isvch) + + + call psb_init_conv(methdname,istop_,itrace_,itmax_,a,b,eps,desc_a,stopdat,info) + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + itx = 0 + restart: do +!!$ +!!$ r0 = b-ax0 +!!$ + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),' restart: ',itx,it + if (itx >= itmax_) exit restart + + it = 0 + call psb_geaxpby(zone,b,zzero,r,desc_a,info) + if (info == psb_success_) call psb_spmm(-zone,a,x,zone,r,desc_a,info,work=aux) + + if (info == psb_success_) call prec%apply(r,desc_a,info) + + if (info == psb_success_) call psb_geaxpby(zone,r,zzero,rt0,desc_a,info) + if (info == psb_success_) call psb_geaxpby(zone,r,zzero,rh(0),desc_a,info) + if (info == psb_success_) call psb_geaxpby(zzero,r,zzero,uh(0),desc_a,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + rho = zone + alpha = zzero + omega = zone + + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' on entry to amax: b: ',b%get_nrows() + + if (psb_check_conv(methdname,itx,x,r,desc_a,stopdat,info)) exit restart + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + iteration: do + it = it + nl + itx = itx + nl + rho = -omega*rho + + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' iteration: ',itx, rho + + do j = 0, nl -1 + If (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),'bicg part: ',j, nl + + rho_old = rho + rho = psb_gedot(rh(j),rt0,desc_a,info) + if (rho == zzero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' bi-cgstab iteration breakdown r',rho + exit iteration + endif + + beta = alpha*rho/rho_old + rho_old = rho + do k=0, j +!!$ call psb_geaxpby(zone,rh(:,0:j),-beta,uh(:,0:j),desc_a,info) + call psb_geaxpby(zone,rh(k),-beta,uh(k),desc_a,info) + end do + call psb_spmm(zone,a,uh(j),zzero,uh(j+1),desc_a,info,work=aux) + + call prec%apply(uh(j+1),desc_a,info) + + gamma(j) = psb_gedot(uh(j+1),rt0,desc_a,info) + + if (gamma(j) == zzero) then + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' bi-cgstab iteration breakdown s2',gamma(j) + exit iteration + endif + alpha = rho/gamma(j) + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' bicg part: alpha=r/g ',alpha,rho,gamma(j) + + do k=0,j +!!$ call psb_geaxpby(-alpha,uh(:,1:j+1),zone,rh(:,0:j),desc_a,info) + call psb_geaxpby(-alpha,uh(k+1),zone,rh(k),desc_a,info) + end do + call psb_geaxpby(alpha,uh(0),zone,x,desc_a,info) + call psb_spmm(zone,a,rh(j),zzero,rh(j+1),desc_a,info,work=aux) + + call prec%apply(rh(j+1),desc_a,info) + + enddo + + do j=1, nl + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' mod g-s part: ',j, nl + + do i=1, j-1 + taum(i,j) = psb_gedot(rh(i),rh(j),desc_a,info) + taum(i,j) = taum(i,j)/sigma(i) + call psb_geaxpby(-taum(i,j),rh(i),zone,rh(j),desc_a,info) + enddo + sigma(j) = psb_gedot(rh(j),rh(j),desc_a,info) + gamma1(j) = psb_gedot(rh(0),rh(j),desc_a,info) + gamma1(j) = gamma1(j)/sigma(j) + enddo + + gamma(nl) = gamma1(nl) + omega = gamma(nl) + + do j=nl-1,1,-1 + gamma(j) = gamma1(j) + do i=j+1,nl + gamma(j) = gamma(j) - taum(j,i) * gamma(i) + enddo + enddo + + do j=1,nl-1 + gamma2(j) = gamma(j+1) + do i=j+1,nl-1 + gamma2(j) = gamma2(j) + taum(j,i) * gamma(i+1) + enddo + enddo + + call psb_geaxpby(gamma(1),rh(0),zone,x,desc_a,info) + call psb_geaxpby(-gamma1(nl),rh(nl),zone,rh(0),desc_a,info) + call psb_geaxpby(-gamma(nl),uh(nl),zone,uh(0),desc_a,info) + + do j=1, nl-1 + call psb_geaxpby(-gamma(j),uh(j),zone,uh(0),desc_a,info) + call psb_geaxpby(gamma2(j),rh(j),zone,x,desc_a,info) + call psb_geaxpby(-gamma1(j),rh(j),zone,rh(0),desc_a,info) + enddo + + if (psb_check_conv(methdname,itx,x,rh(0),desc_a,stopdat,info)) exit restart + if (info /= psb_success_) Then + call psb_errpush(psb_err_from_subroutine_non_,name) + goto 9999 + End If + + end do iteration + end do restart + + call psb_end_conv(methdname,itx,desc_a,stopdat,info,derr,iter) + if (present(err)) err = derr + + if (info == psb_success_) call psb_gefree(uh,desc_a,info) + if (info == psb_success_) call psb_gefree(rh,desc_a,info) + if (info == psb_success_) call psb_gefree(wwrk,desc_a,info) + if (info == psb_success_) deallocate(aux,stat=info) + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + + ! restore external global coherence behaviour + call psb_restore_coher(ictxt,isvch) + 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 psb_zcgstabl_vect + + + diff --git a/krylov/psb_zkrylov.f90 b/krylov/psb_zkrylov.f90 index 7f6d7ff2b..46222c544 100644 --- a/krylov/psb_zkrylov.f90 +++ b/krylov/psb_zkrylov.f90 @@ -243,3 +243,176 @@ Subroutine psb_zkrylov(method,a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,i end subroutine psb_zkrylov + +Subroutine psb_zkrylov_vect(method,a,prec,b,x,eps,desc_a,info,& + & itmax,iter,err,itrace,irst,istop,cond) + + use psb_base_mod + use psb_prec_mod,only : psb_zprec_type + use psb_krylov_mod, psb_protect_name => psb_zkrylov_vect + + character(len=*) :: method + Type(psb_zspmat_type), Intent(in) :: a + Type(psb_desc_type), Intent(in) :: desc_a + class(psb_zprec_type), intent(inout) :: prec + type(psb_z_vect_type), Intent(inout) :: b + type(psb_z_vect_type), Intent(inout) :: x + Real(psb_dpk_), Intent(in) :: eps + integer, intent(out) :: info + Integer, Optional, Intent(in) :: itmax, itrace, irst,istop + Integer, Optional, Intent(out) :: iter + Real(psb_dpk_), Optional, Intent(out) :: err,cond + + interface + subroutine psb_zcg_vect(a,prec,b,x,eps,& + & desc_a,info,itmax,iter,err,itrace,istop,cond) + use psb_base_mod, only : psb_desc_type, psb_zspmat_type,& + & psb_dpk_, psb_z_vect_type + use psb_prec_mod, only : psb_zprec_type + type(psb_zspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + class(psb_zprec_type), intent(inout) :: prec + type(psb_z_vect_type), Intent(inout) :: b + type(psb_z_vect_type), Intent(inout) :: x + real(psb_dpk_), intent(in) :: eps + integer, intent(out) :: info + integer, optional, intent(in) :: itmax, itrace,istop + integer, optional, intent(out) :: iter + real(psb_dpk_), optional, intent(out) :: err,cond + end subroutine psb_zcg_vect + subroutine psb_zbicg_vect(a,prec,b,x,eps,& + & desc_a,info,itmax,iter,err,itrace,istop) + use psb_base_mod, only : psb_desc_type, psb_zspmat_type,& + & psb_dpk_, psb_z_vect_type + use psb_prec_mod, only : psb_zprec_type + type(psb_zspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + class(psb_zprec_type), intent(inout) :: prec + type(psb_z_vect_type), Intent(inout) :: b + type(psb_z_vect_type), Intent(inout) :: x + real(psb_dpk_), intent(in) :: eps + integer, intent(out) :: info + integer, optional, intent(in) :: itmax, itrace,istop + integer, optional, intent(out) :: iter + real(psb_dpk_), optional, intent(out) :: err + end subroutine psb_zbicg_vect + subroutine psb_zcgstab_vect(a,prec,b,x,eps,& + & desc_a,info,itmax,iter,err,itrace,istop) + use psb_base_mod, only : psb_desc_type, psb_zspmat_type,& + & psb_dpk_, psb_z_vect_type + use psb_prec_mod, only : psb_zprec_type + type(psb_zspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + type(psb_z_vect_type), Intent(inout) :: b + type(psb_z_vect_type), Intent(inout) :: x + real(psb_dpk_), intent(in) :: eps + class(psb_zprec_type), intent(inout) :: prec + integer, intent(out) :: info + integer, optional, intent(in) :: itmax, itrace,istop + integer, optional, intent(out) :: iter + real(psb_dpk_), optional, intent(out) :: err + end subroutine psb_zcgstab_vect + Subroutine psb_zcgstabl_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err, itrace,irst,istop) + use psb_base_mod, only : psb_desc_type, psb_zspmat_type, & + & psb_dpk_, psb_z_vect_type + use psb_prec_mod, only : psb_zprec_type + Type(psb_zspmat_type), Intent(in) :: a + Type(psb_desc_type), Intent(in) :: desc_a + class(psb_zprec_type), intent(inout) :: prec + type(psb_z_vect_type), Intent(inout) :: b + type(psb_z_vect_type), Intent(inout) :: x + Real(psb_dpk_), Intent(in) :: eps + integer, intent(out) :: info + Integer, Optional, Intent(in) :: itmax, itrace, irst,istop + Integer, Optional, Intent(out) :: iter + Real(psb_dpk_), Optional, Intent(out) :: err + end subroutine psb_zcgstabl_vect + Subroutine psb_zrgmres_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err,itrace,irst,istop) + use psb_base_mod, only : psb_desc_type, psb_zspmat_type,& + & psb_dpk_, psb_z_vect_type + use psb_prec_mod, only : psb_zprec_type + Type(psb_zspmat_type), Intent(in) :: a + Type(psb_desc_type), Intent(in) :: desc_a + class(psb_zprec_type), intent(inout) :: prec + type(psb_z_vect_type), Intent(inout) :: b + type(psb_z_vect_type), Intent(inout) :: x + Real(psb_dpk_), Intent(in) :: eps + integer, intent(out) :: info + Integer, Optional, Intent(in) :: itmax, itrace, irst,istop + Integer, Optional, Intent(out) :: iter + Real(psb_dpk_), Optional, Intent(out) :: err + end subroutine psb_zrgmres_vect + subroutine psb_zcgs_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err,itrace,istop) + use psb_base_mod, only : psb_desc_type, psb_zspmat_type,& + & psb_dpk_, psb_z_vect_type + use psb_prec_mod, only : psb_zprec_type + type(psb_zspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + class(psb_zprec_type), intent(inout) :: prec + type(psb_z_vect_type), Intent(inout) :: b + type(psb_z_vect_type), Intent(inout) :: x + real(psb_dpk_), intent(in) :: eps + integer, intent(out) :: info + integer, optional, intent(in) :: itmax, itrace,istop + integer, optional, intent(out) :: iter + real(psb_dpk_), optional, intent(out) :: err + end subroutine psb_zcgs_vect + end interface + integer :: ictxt,me,np,err_act + character(len=20) :: name + + info = psb_success_ + name = 'psb_krylov' + call psb_erractionsave(err_act) + + ictxt=desc_a%get_context() + + call psb_info(ictxt, me, np) + + select case(psb_toupper(method)) + case('CG') + call psb_zcg_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err,itrace,istop,cond) + case('CGS') + call psb_zcgs_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err,itrace,istop) + case('BICG') + call psb_zbicg_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err,itrace,istop) + case('BICGSTAB') + call psb_zcgstab_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err,itrace,istop) + case('RGMRES') + call psb_zrgmres_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err,itrace,irst,istop) + case('BICGSTABL') + call psb_zcgstabl_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err,itrace,irst,istop) + case default + if (me == 0) write(psb_err_unit,*) trim(name),& + & ': Warning: Unknown method ',method,& + & ', defaulting to BiCGSTAB' + call psb_zcgstab_vect(a,prec,b,x,eps,desc_a,info,& + &itmax,iter,err,itrace,istop) + end select + + if(info /= psb_success_) 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(ictxt) + return + end if + +end subroutine psb_zkrylov_vect + diff --git a/krylov/psb_zrgmres.f90 b/krylov/psb_zrgmres.f90 index 7db1454e1..8c91a72dc 100644 --- a/krylov/psb_zrgmres.f90 +++ b/krylov/psb_zrgmres.f90 @@ -108,7 +108,7 @@ Subroutine psb_zrgmres(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,istop) use psb_base_mod use psb_prec_mod - use psb_inner_krylov_mod + use psb_z_inner_krylov_mod use psb_krylov_mod implicit none @@ -586,3 +586,501 @@ contains return end subroutine zrotg End Subroutine psb_zrgmres + +subroutine psb_zrgmres_vect(a,prec,b,x,eps,desc_a,info,& + & itmax,iter,err,itrace,irst,istop) + use psb_base_mod + use psb_prec_mod + use psb_z_inner_krylov_mod + use psb_krylov_mod + implicit none + type(psb_zspmat_type), intent(in) :: a + Type(psb_desc_type), Intent(in) :: desc_a + class(psb_zprec_type), intent(inout) :: prec + type(psb_z_vect_type), Intent(inout) :: b + type(psb_z_vect_type), Intent(inout) :: x + Real(psb_dpk_), Intent(in) :: eps + integer, intent(out) :: info + Integer, Optional, Intent(in) :: itmax, itrace, irst,istop + Integer, Optional, Intent(out) :: iter + Real(psb_dpk_), Optional, Intent(out) :: err +!!$ local data + complex(psb_dpk_), allocatable :: aux(:) + complex(psb_dpk_), allocatable :: c(:), s(:), h(:,:), rs(:), rst(:) + type(psb_z_vect_type), allocatable :: v(:) + type(psb_z_vect_type) :: w, w1, xt + real(psb_dpk_) :: tmp + complex(psb_dpk_) :: scal, gm, rti, rti1 + Integer ::litmax, naux, mglob, it,k, itrace_,& + & np,me, n_row, n_col, nl, int_err(5) + Logical, Parameter :: exchange=.True., noexchange=.False., use_srot=.true. + Integer, Parameter :: irmax = 8 + Integer :: itx, i, isvch, ictxt,istop_, err_act + integer :: debug_level, debug_unit + Real(psb_dpk_) :: rni, xni, bni, ani,bn2, dt + real(psb_dpk_) :: errnum, errden, deps, derr + character(len=20) :: name + character(len=*), parameter :: methdname='RGMRES' + + info = psb_success_ + name = 'psb_zgmres' + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + ictxt = desc_a%get_context() + Call psb_info(ictxt, me, np) + if (debug_level >= psb_debug_ext_)& + & write(debug_unit,*) me,' ',trim(name),': from psb_info',np + if (.not.allocated(b%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + if (.not.allocated(x%v)) then + info = psb_err_invalid_vect_state_ + call psb_errpush(info,name) + goto 9999 + endif + + mglob = desc_a%get_global_rows() + n_row = desc_a%get_local_rows() + n_col = desc_a%get_local_cols() + + if (present(istop)) then + istop_ = istop + else + istop_ = 2 + endif +! +! ISTOP_ = 1: Normwise backward error, infinity norm +! ISTOP_ = 2: ||r||/||b||, 2-norm +! + + if ((istop_ < 1 ).or.(istop_ > 2 ) ) then + info=psb_err_invalid_istop_ + int_err(1)=istop_ + err=info + call psb_errpush(info,name,i_err=int_err) + goto 9999 + endif + + if (present(itmax)) then + litmax = itmax + else + litmax = 1000 + endif + + if (present(itrace)) then + itrace_ = itrace + else + itrace_ = 0 + end if + + if (present(irst)) then + nl = irst + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' present: irst: ',irst,nl + else + nl = 10 + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' not present: irst: ',irst,nl + endif + if (nl <=0 ) then + info=psb_err_invalid_istop_ + int_err(1)=nl + err=info + call psb_errpush(info,name,i_err=int_err) + goto 9999 + endif + + call psb_chkvect(mglob,1,x%get_nrows(),1,1,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_chkvect on X') + goto 9999 + end if + call psb_chkvect(mglob,1,b%get_nrows(),1,1,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='psb_chkvect on B') + goto 9999 + end if + + + naux=4*n_col + allocate(aux(naux),h(nl+1,nl+1),& + &c(nl+1),s(nl+1),rs(nl+1), rst(nl+1),stat=info) + + if (info == psb_success_) call psb_geall(v,desc_a,info,n=nl+1) + if (info == psb_success_) call psb_geall(w,desc_a,info) + if (info == psb_success_) call psb_geall(w1,desc_a,info) + if (info == psb_success_) call psb_geall(xt,desc_a,info) + if (info == psb_success_) call psb_geasb(v,desc_a,info,mold=x%v) + if (info == psb_success_) call psb_geasb(w,desc_a,info,mold=x%v) + if (info == psb_success_) call psb_geasb(w1,desc_a,info,mold=x%v) + if (info == psb_success_) call psb_geasb(xt,desc_a,info,mold=x%v) + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' Size of V,W,W1 ',v(1)%get_nrows(),size(v),& + & w%get_nrows(),w1%get_nrows() + + ! Ensure global coherence for convergence checks. + call psb_set_coher(ictxt,isvch) + + if (istop_ == 1) then + ani = psb_spnrmi(a,desc_a,info) + bni = psb_geamax(b,desc_a,info) + else if (istop_ == 2) then + bn2 = psb_genrm2(b,desc_a,info) + endif + errnum = zzero + errden = zone + deps = eps + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + if ((itrace_ > 0).and.(me == 0)) call log_header(methdname) + + itx = 0 + restart: do + + ! compute r0 = b-ax0 + ! check convergence + ! compute v1 = r0/||r0||_2 + + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' restart: ',itx,it + it = 0 + call psb_geaxpby(zone,b,zzero,v(1),desc_a,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + call psb_spmm(-zone,a,x,zone,v(1),desc_a,info,work=aux) + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + rs(1) = psb_genrm2(v(1),desc_a,info) + rs(2:) = zzero + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + scal=zone/rs(1) ! rs(1) MIGHT BE VERY SMALL - USE DSCAL TO DEAL WITH IT? + + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' on entry to amax: b: ',b%get_nrows(),rs(1),scal + + ! + ! check convergence + ! + if (istop_ == 1) then + rni = psb_geamax(v(1),desc_a,info) + xni = psb_geamax(x,desc_a,info) + errnum = rni + errden = (ani*xni+bni) + else if (istop_ == 2) then + rni = psb_genrm2(v(1),desc_a,info) + errnum = rni + errden = bn2 + endif + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + if (errnum <= eps*errden) exit restart + + if (itrace_ > 0) & + & call log_conv(methdname,me,itx,itrace_,errnum,errden,deps) + + call v(1)%scal(scal) !v(1) = v(1) * scal + + if (itx >= litmax) exit restart + + ! + ! inner iterations + ! + + inner: Do i=1,nl + itx = itx + 1 + + call prec%apply(v(i),w1,desc_a,info) + call psb_spmm(zone,a,w1,zzero,w,desc_a,info,work=aux) + ! + + do k = 1, i + h(k,i) = psb_gedot(v(k),w,desc_a,info) + call psb_geaxpby(-h(k,i),v(k),zone,w,desc_a,info) + end do + h(i+1,i) = psb_genrm2(w,desc_a,info) + scal=zone/h(i+1,i) + call psb_geaxpby(scal,w,zzero,v(i+1),desc_a,info) + do k=2,i + call zrot(1,h(k-1,i),1,h(k,i),1,real(c(k-1)),s(k-1)) + enddo + + rti = h(i,i) + rti1 = h(i+1,i) + call zrotg(rti,rti1,tmp,s(i)) + c(i) = cmplx(tmp,dzero,kind=psb_dpk_) + call zrot(1,h(i,i),1,h(i+1,i),1,real(c(i)),s(i)) + h(i+1,i) = zzero + call zrot(1,rs(i),1,rs(i+1),1,real(c(i)),s(i)) + + if (istop_ == 1) then + ! + ! build x and then compute the residual and its infinity norm + ! + rst = rs + call w1%set(zzero) + call ztrsm('l','u','n','n',i,1,zone,h,size(h,1),rst,size(rst,1)) + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' Rebuild x-> RS:',rst(1:nl) + do k=1, i + call psb_geaxpby(rst(k),v(k),zone,xt,desc_a,info) + end do + call prec%apply(xt,desc_a,info) + call psb_geaxpby(zone,x,zone,xt,desc_a,info) + call psb_geaxpby(zone,b,zzero,w1,desc_a,info) + call psb_spmm(-zone,a,xt,zone,w1,desc_a,info,work=aux) + rni = psb_geamax(w1,desc_a,info) + xni = psb_geamax(xt,desc_a,info) + errnum = rni + errden = (ani*xni+bni) + ! + + else if (istop_ == 2) then + ! + ! compute the residual 2-norm as byproduct of the solution + ! procedure of the least-squares problem + ! + rni = abs(rs(i+1)) + errnum = rni + errden = bn2 + endif + + if (errnum <= eps*errden) then + + if (istop_ == 1) then + call psb_geaxpby(zone,xt,zzero,x,desc_a,info) +!!$ x = xt + else if (istop_ == 2) then + ! + ! build x + ! + call ztrsm('l','u','n','n',i,1,zone,h,size(h,1),rs,size(rs,1)) + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' Rebuild x-> RS:',rs(1:nl) + call w1%set(zzero) + do k=1, i + call psb_geaxpby(rs(k),v(k),zone,w1,desc_a,info) + end do + call prec%apply(w1,w,desc_a,info) + call psb_geaxpby(zone,w,zone,x,desc_a,info) + end if + + exit restart + + end if + + if (itrace_ > 0) & + & call log_conv(methdname,me,itx,itrace_,errnum,errden,deps) + + end do inner + + if (istop_ == 1) then + call psb_geaxpby(zone,xt,zzero,x,desc_a,info)! x = xt + else if (istop_ == 2) then + ! + ! build x + ! + call ztrsm('l','u','n','n',nl,1,zone,h,size(h,1),rs,size(rs,1)) + if (debug_level >= psb_debug_ext_) & + & write(debug_unit,*) me,' ',trim(name),& + & ' Rebuild x-> RS:',rs(1:nl) + call w1%set(zzero) + do k=1, nl + call psb_geaxpby(rs(k),v(k),zone,w1,desc_a,info) + end do + call prec%apply(w1,w,desc_a,info) + call psb_geaxpby(zone,w,zone,x,desc_a,info) + end if + + end do restart + if (itrace_ > 0) & + & call log_conv(methdname,me,itx,1,errnum,errden,deps) + + call log_end(methdname,me,itx,errnum,errden,deps,err=derr,iter=iter) + if (present(err)) err = derr + + + if (info == psb_success_) call psb_gefree(v,desc_a,info) + if (info == psb_success_) call psb_gefree(w,desc_a,info) + if (info == psb_success_) call psb_gefree(w1,desc_a,info) + if (info == psb_success_) call psb_gefree(xt,desc_a,info) + if (info == psb_success_) deallocate(aux,h,c,s,rs,rst, stat=info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_non_ + call psb_errpush(info,name) + goto 9999 + end if + + ! restore external global coherence behaviour + call psb_restore_coher(ictxt,isvch) + + 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 zrot( n, cx, incx, cy, incy, c, s ) + ! + ! -- lapack auxiliary routine (version 3.0) -- + ! univ. of tennessee, univ. of california berkeley, nag ltd., + ! courant institute, argonne national lab, and rice university + ! october 31, 1992 + ! + ! .. scalar arguments .. + integer incx, incy, n + real(psb_dpk_) c + complex(psb_dpk_) s + ! .. + ! .. array arguments .. + complex(psb_dpk_) cx( * ), cy( * ) + ! .. + ! + ! purpose + ! == = ==== + ! + ! zrot applies a plane rotation, where the cos (c) is real and the + ! sin (s) is complex, and the vectors cx and cy are complex. + ! + ! arguments + ! == = ====== + ! + ! n (input) integer + ! the number of elements in the vectors cx and cy. + ! + ! cx (input/output) complex*16 array, dimension (n) + ! on input, the vector x. + ! on output, cx is overwritten with c*x + s*y. + ! + ! incx (input) integer + ! the increment between successive values of cy. incx <> 0. + ! + ! cy (input/output) complex*16 array, dimension (n) + ! on input, the vector y. + ! on output, cy is overwritten with -conjg(s)*x + c*y. + ! + ! incy (input) integer + ! the increment between successive values of cy. incx <> 0. + ! + ! c (input) double precision + ! s (input) complex*16 + ! c and s define a rotation + ! [ c s ] + ! [ -conjg(s) c ] + ! where c*c + s*conjg(s) = 1.0. + ! + ! == = ================================================================== + ! + ! .. local scalars .. + integer i, ix, iy + complex(psb_dpk_) stemp + ! .. + ! .. intrinsic functions .. + intrinsic dconjg + ! .. + ! .. executable statements .. + ! + if( n <= 0 ) return + if( incx == 1 .and. incy == 1 ) then + ! + ! code for both increments equal to 1 + ! + do i = 1, n + stemp = c*cx(i) + s*cy(i) + cy(i) = c*cy(i) - dconjg(s)*cx(i) + cx(i) = stemp + end do + else + ! + ! code for unequal increments or equal increments not equal to 1 + ! + ix = 1 + iy = 1 + if( incx < 0 )ix = ( -n+1 )*incx + 1 + if( incy < 0 )iy = ( -n+1 )*incy + 1 + do i = 1, n + stemp = c*cx(ix) + s*cy(iy) + cy(iy) = c*cy(iy) - dconjg(s)*cx(ix) + cx(ix) = stemp + ix = ix + incx + iy = iy + incy + end do + end if + return + return + end subroutine zrot + ! + ! + subroutine zrotg(ca,cb,c,s) + complex(psb_dpk_) ca,cb,s + real(psb_dpk_) c + real(psb_dpk_) norm,scale + complex(psb_dpk_) alpha + ! + if (cdabs(ca) == 0.0d0) then + ! + c = 0.0d0 + s = (1.0d0,0.0d0) + ca = cb + return + end if + ! + + scale = cdabs(ca) + cdabs(cb) + norm = scale*dsqrt((cdabs(ca/cmplx(scale,0.0d0,kind=psb_dpk_)))**2 +& + & (cdabs(cb/cmplx(scale,0.0d0,kind=psb_dpk_)))**2) + alpha = ca /cdabs(ca) + c = cdabs(ca) / norm + s = alpha * conjg(cb) / norm + ca = alpha * norm + ! + + return + end subroutine zrotg + +end subroutine psb_zrgmres_vect + diff --git a/opt/Makefile b/opt/Makefile index c637fa216..52c1fecd6 100644 --- a/opt/Makefile +++ b/opt/Makefile @@ -18,11 +18,7 @@ LIBDIR=../lib EXEDIR=./runs -OBJS=psb_d_ell_impl.o psb_d_ell_mat_mod.o \ - rsb_z_mod.o psb_z_rsb_mat_mod.o \ - rsb_c_mod.o psb_c_rsb_mat_mod.o \ - rsb_s_mod.o psb_s_rsb_mat_mod.o \ - rsb_d_mod.o psb_d_rsb_mat_mod.o +OBJS=psb_d_ell_impl.o psb_d_ell_mat_mod.o LIBNAME=libpsb_opt.a @@ -37,32 +33,6 @@ libpsb_opt.a: $(OBJS) ar cur libpsb_opt.a $(OBJS) psb_d_ell_impl.o: psb_d_ell_mat_mod.o -psb_d_rsb_mat_mod.o: rsb_d_mod.o -psb_z_rsb_mat_mod.o: rsb_z_mod.o -psb_c_rsb_mat_mod.o: rsb_c_mod.o -psb_s_rsb_mat_mod.o: rsb_s_mod.o - -RSBD2Z=sed 's/c_typecode=68/c_typecode=90/g;s/rsb_d_/rsb_z_/g;s/psb_d_/psb_z_/g;s/real(psb_dpk_)/complex(psb_dpk_)/g;s/real(c_double)/complex(c_double)/g;s/complex(psb_dpk_)\(.*\)csnmi_res/real(psb_dpk_)\1csnmi_res/g' -RSBD2S=sed 's/c_typecode=68/c_typecode=83/g;s/rsb_d_/rsb_s_/g;s/psb_d_/psb_s_/g;s/real(psb_dpk_)/real(psb_spk_)/g;s/real(c_double)/real(c_float)/g;s/real(psb_dpk_)\(.*\)csnmi_res/real(psb_spk_)\1csnmi_res/g' -RSBD2C=sed 's/c_typecode=68/c_typecode=67/g;s/rsb_d_/rsb_c_/g;s/psb_d_/psb_c_/g;s/real(psb_dpk_)/complex(psb_spk_)/g;s/real(c_double)/complex(c_float)/g;s/complex(psb_spk_)\(.*\)csnmi_res/real(psb_spk_)\1csnmi_res/g' - -psb_z_rsb_mat_mod.F90: psb_d_rsb_mat_mod.F90 Makefile - $(RSBD2Z) $< > $@ - -rsb_z_mod.f90: rsb_d_mod.f90 Makefile - $(RSBD2Z) $< > $@ - -psb_c_rsb_mat_mod.F90: psb_d_rsb_mat_mod.F90 Makefile - $(RSBD2C) $< > $@ - -rsb_c_mod.f90: rsb_d_mod.f90 Makefile - $(RSBD2C) $< > $@ - -psb_s_rsb_mat_mod.F90: psb_d_rsb_mat_mod.F90 Makefile - $(RSBD2S) $< > $@ - -rsb_s_mod.f90: rsb_d_mod.f90 Makefile - $(RSBD2S) $< > $@ clean: diff --git a/opt/psb_c_rsb_mat_mod.F90 b/opt/psb_c_rsb_mat_mod.F90 deleted file mode 100644 index e9673dcd6..000000000 --- a/opt/psb_c_rsb_mat_mod.F90 +++ /dev/null @@ -1,962 +0,0 @@ -! -! -! FIXME/TODO: -! * some RSB constants are used in their value form, and with no explanation -! * error handling -! * PSBLAS interface adherence -! * should test and fix all the problems that for sure will occur -! * duplicate handling is not defined -! * the printing function is not complete -! * should substitute -1 with another valid PSBLAS error code -! * .. -! -module psb_c_rsb_mat_mod - use psb_c_base_mat_mod - use rsb_c_mod -#ifdef HAVE_LIBRSB - use iso_c_binding -#endif -#if 0 -#define PSBRSB_DEBUG(MSG) write(*,*) __FILE__,':',__LINE__,':',MSG -#define PSBRSB_ERROR(MSG) write(*,*) __FILE__,':',__LINE__,':'," ERROR: ",MSG -#define PSBRSB_WARNING(MSG) write(*,*) __FILE__,':',__LINE__,':'," WARNING: ",MSG -#else -#define PSBRSB_DEBUG(MSG) -#define PSBRSB_ERROR(MSG) -#define PSBRSB_WARNING(MSG) -#endif - integer, parameter :: c_typecode=67 ! this is module specific - integer, parameter :: c_for_flags=1 ! : here should use RSB_FLAG_FORTRAN_INDICES_INTERFACE - integer, parameter :: c_srt_flags =4 ! flags if rsb input is row major sorted .. - !integer, parameter :: c_own_flags =-1 ! flags if rsb input shall not be freed by rsb - integer, parameter :: c_tri_flags =8 ! flags for specifying a triangle - integer, parameter :: c_low_flags =16 ! flags for specifying a lower triangle/symmetry - integer, parameter :: c_upp_flags =32 ! flags for specifying a lower triangle/symmetry - integer, parameter :: c_idi_flags =64 ! flags for specifying diagonal implicit - integer, parameter :: c_def_flags =c_for_flags ! FIXME: here should use .. - integer :: c_f_order=c_for_flags ! FIXME: here should use RSB_FLAG_WANT_COLUMN_MAJOR_ORDER - integer, parameter :: c_upd_flags =c_for_flags ! flags for when updating the assembled rsb matrix - integer, parameter :: c_psbrsb_err_ =psb_err_internal_error_ - type, extends(psb_c_base_sparse_mat) :: psb_c_rsb_sparse_mat -#ifdef HAVE_LIBRSB - type(c_ptr) :: rsbmptr=c_null_ptr - contains - procedure, pass(a) :: get_size => d_rsb_get_size - procedure, pass(a) :: get_nzeros => d_rsb_get_nzeros - procedure, pass(a) :: get_ncols => d_rsb_get_ncols - procedure, pass(a) :: get_nrows => d_rsb_get_nrows - procedure, nopass :: get_fmt => d_rsb_get_fmt - procedure, pass(a) :: sizeof => d_rsb_sizeof - procedure, pass(a) :: d_csmm => psb_c_rsb_csmm - !procedure, pass(a) :: d_csmv_nt => psb_c_rsb_csmv_nt ! FIXME: a placeholder for future memory - procedure, pass(a) :: d_csmv => psb_c_rsb_csmv - procedure, pass(a) :: d_inner_cssm => psb_c_rsb_cssm - procedure, pass(a) :: d_inner_cssv => psb_c_rsb_cssv - procedure, pass(a) :: d_scals => psb_c_rsb_scals - procedure, pass(a) :: d_scal => psb_c_rsb_scal - procedure, pass(a) :: csnmi => psb_c_rsb_csnmi - procedure, pass(a) :: csnm1 => psb_c_rsb_csnm1 - procedure, pass(a) :: rowsum => psb_c_rsb_rowsum - procedure, pass(a) :: arwsum => psb_c_rsb_arwsum - procedure, pass(a) :: colsum => psb_c_rsb_colsum - procedure, pass(a) :: aclsum => psb_c_rsb_aclsum -! procedure, pass(a) :: reallocate_nz => psb_c_rsb_reallocate_nz ! FIXME -! procedure, pass(a) :: allocate_mnnz => psb_c_rsb_allocate_mnnz ! FIXME - procedure, pass(a) :: cp_to_coo => psb_c_cp_rsb_to_coo - procedure, pass(a) :: cp_from_coo => psb_c_cp_rsb_from_coo - procedure, pass(a) :: cp_to_fmt => psb_c_cp_rsb_to_fmt - procedure, pass(a) :: cp_from_fmt => psb_c_cp_rsb_from_fmt - procedure, pass(a) :: mv_to_coo => psb_c_mv_rsb_to_coo - procedure, pass(a) :: mv_from_coo => psb_c_mv_rsb_from_coo - procedure, pass(a) :: mv_to_fmt => psb_c_mv_rsb_to_fmt - procedure, pass(a) :: mv_from_fmt => psb_c_mv_rsb_from_fmt - procedure, pass(a) :: csput => psb_c_rsb_csput - procedure, pass(a) :: get_diag => psb_c_rsb_get_diag - procedure, pass(a) :: csgetptn => psb_c_rsb_csgetptn - procedure, pass(a) :: d_csgetrow => psb_c_rsb_csgetrow - procedure, pass(a) :: get_nz_row => d_rsb_get_nz_row - procedure, pass(a) :: reinit => psb_c_rsb_reinit - procedure, pass(a) :: trim => psb_c_rsb_trim ! evil - procedure, pass(a) :: print => psb_c_rsb_print - procedure, pass(a) :: free => d_rsb_free - procedure, pass(a) :: mold => psb_c_rsb_mold - procedure, pass(a) :: psb_c_rsb_cp_from - generic, public :: cp_from => psb_c_rsb_cp_from - procedure, pass(a) :: psb_c_rsb_mv_from - generic, public :: mv_from => psb_c_rsb_mv_from - -#endif - end type psb_c_rsb_sparse_mat - ! FIXME: complete the following - !private :: d_rsb_get_nzeros, d_rsb_get_fmt - private :: d_rsb_to_psb_info -#ifdef HAVE_LIBRSB - contains - - function psb_rsb_matmod_init() result(res) - implicit none - integer :: res - !PSBRSB_DEBUG('') - res=-1 ! FIXME -#ifdef HAVE_LIBRSB - res=d_rsb_to_psb_info(rsb_init(c_null_ptr)) -#endif - end function psb_rsb_matmod_init - - function psb_rsb_matmod_exit() result(res) - implicit none - integer :: res - !PSBRSB_DEBUG('') - res=-1 ! FIXME -#ifdef HAVE_LIBRSB - res=d_rsb_to_psb_info(rsb_exit()) -#endif - end function psb_rsb_matmod_exit - - function d_rsb_to_psb_info(info) result(res) - implicit none - integer , intent(in) :: info - integer :: res - !PSBRSB_DEBUG('') - if(info.ne.0)then - res=-1 - else - res=psb_success_ - end if - end function d_rsb_to_psb_info - - function d_rsb_get_flags(a) result(flags) - implicit none - integer :: flags - class(psb_c_base_sparse_mat), intent(in) :: a - !PSBRSB_DEBUG('') - flags=c_def_flags - if(a%is_sorted()) flags=flags+c_srt_flags - if(a%is_triangle()) flags=flags+c_tri_flags - if(a%is_upper()) flags=flags+c_upp_flags - if(a%is_unit()) flags=flags+c_idi_flags - if(a%is_lower()) flags=flags+c_low_flags - end function d_rsb_get_flags - - function d_rsb_get_nzeros(a) result(res) - implicit none - class(psb_c_rsb_sparse_mat), intent(in) :: a - integer :: res - !PSBRSB_DEBUG('') - res=rsb_get_matrix_nnz(a%rsbmptr) - end function d_rsb_get_nzeros - - function d_rsb_get_nrows(a) result(res) - implicit none - class(psb_c_rsb_sparse_mat), intent(in) :: a - integer :: res - !PSBRSB_DEBUG('') - res=rsb_get_matrix_n_rows(a%rsbmptr) - end function d_rsb_get_nrows - - function d_rsb_get_ncols(a) result(res) - implicit none - class(psb_c_rsb_sparse_mat), intent(in) :: a - integer :: res - !PSBRSB_DEBUG('') - res=rsb_get_matrix_n_columns(a%rsbmptr) - end function d_rsb_get_ncols - - function d_rsb_get_fmt() result(res) - implicit none - character(len=5) :: res - !the following printout is harmful, here, if happening during a write :) (causes a deadlock) - !PSBRSB_DEBUG('') - res = 'RSB' - end function d_rsb_get_fmt - - function d_rsb_get_size(a) result(res) - implicit none - class(psb_c_rsb_sparse_mat), intent(in) :: a - integer :: res - !PSBRSB_DEBUG('') - res = d_rsb_get_nzeros(a) - end function d_rsb_get_size - - function d_rsb_sizeof(a) result(res) - implicit none - class(psb_c_rsb_sparse_mat), intent(in) :: a - integer(psb_long_int_k_) :: res - !PSBRSB_DEBUG('') - res=rsb_sizeof(a%rsbmptr) - end function d_rsb_sizeof - -subroutine psb_c_rsb_csmv(alpha,a,x,beta,y,info,trans) - implicit none - class(psb_c_rsb_sparse_mat), intent(in) :: a - complex(psb_spk_), intent(in) :: alpha, beta, x(:) - complex(psb_spk_), intent(inout) :: y(:) - integer, intent(out) :: info - character, optional, intent(in) :: trans - character :: trans_ -! PSBRSB_DEBUG('') - info = psb_success_ - - if (present(trans)) then - trans_ = trans - else - trans_ = 'N' - end if - info=d_rsb_to_psb_info(rsb_spmv(rsb_psblas_trans_to_rsb_trans(trans_),alpha,a%rsbmptr,x,1,beta,y,1)) -end subroutine psb_c_rsb_csmv - -subroutine psb_c_rsb_csmv_nt(alpha,a,x1,x2,beta,y1,y2,info) - ! FIXME: this routine is here as a placeholder for a specialized implementation of - ! joint spmv and spmv transposed. - implicit none - class(psb_c_rsb_sparse_mat), intent(in) :: a - complex(psb_spk_), intent(in) :: alpha, beta, x1(:), x2(:) - complex(psb_spk_), intent(inout) :: y1(:), y2(:) - integer, intent(out) :: info -! PSBRSB_DEBUG('') - info = psb_success_ - info=d_rsb_to_psb_info(rsb_spmv_nt(alpha,a%rsbmptr,x1,x2,1,beta,y1,y2,1)) - return -end subroutine psb_c_rsb_csmv_nt - -subroutine psb_c_rsb_cssv(alpha,a,x,beta,y,info,trans) - use psb_error_mod - ! FIXME: and what when x is an alias of y ? - ! FIXME: ignoring beta - implicit none - class(psb_c_rsb_sparse_mat), intent(in) :: a - complex(psb_spk_), intent(in) :: alpha, beta, x(:) - complex(psb_spk_), intent(inout) :: y(:) - integer, intent(out) :: info - character, optional, intent(in) :: trans - character :: trans_ - Integer :: err_act, i - character(len=20) :: name='rsb_cssv' - logical, parameter :: debug=.false. - - info = psb_success_ - call psb_erractionsave(err_act) - -! PSBRSB_DEBUG('') - - if (present(trans)) then - trans_ = trans - else - trans_ = 'N' - end if - info=d_rsb_to_psb_info(rsb_spsv(rsb_psblas_trans_to_rsb_trans(trans_),alpha,a%rsbmptr,x,1,y,1)) - if (info /= 0) then - i = info - info = psb_err_from_subroutine_ai_ - call psb_errpush(info,name,& - & i_err=(/i,0,0,0,0/),a_err="rsb_spsv") - goto 9999 - end if - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - - if (err_act == psb_act_abort_) then - PSBRSB_ERROR("!") - call psb_error() - return - end if - return - -end subroutine psb_c_rsb_cssv - -subroutine psb_c_rsb_scals(d,a,info) - use psb_base_mod - implicit none - class(psb_c_rsb_sparse_mat), intent(inout) :: a - complex(psb_spk_), intent(in) :: d - integer, intent(out) :: info - PSBRSB_DEBUG('') - info=d_rsb_to_psb_info(rsb_elemental_scale(a%rsbmptr,d)) -end subroutine psb_c_rsb_scals - -subroutine psb_c_rsb_scal(d,a,info) - use psb_base_mod - implicit none - class(psb_c_rsb_sparse_mat), intent(inout) :: a - complex(psb_spk_), intent(in) :: d(:) - integer, intent(out) :: info - PSBRSB_DEBUG('') - info=d_rsb_to_psb_info(rsb_scale_rows(a%rsbmptr,d)) -end subroutine psb_c_rsb_scal - - subroutine d_rsb_free(a) - implicit none - class(psb_c_rsb_sparse_mat), intent(inout) :: a - type(c_ptr) :: dummy - !PSBRSB_DEBUG('freeing RSB matrix') - dummy=rsb_free_sparse_matrix(a%rsbmptr) - end subroutine d_rsb_free - -subroutine psb_c_rsb_trim(a) - implicit none - class(psb_c_rsb_sparse_mat), intent(inout) :: a - !PSBRSB_DEBUG('') - ! FIXME: this is supposed to remain empty for RSB -end subroutine psb_c_rsb_trim - - subroutine psb_c_rsb_print(iout,a,iv,eirs,eics,head,ivr,ivc) - integer, intent(in) :: iout - class(psb_c_rsb_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 :: info - PSBRSB_DEBUG('') - ! FIXME: UNFINISHED - info=rsb_print_matrix_t(a%rsbmptr) - end subroutine psb_c_rsb_print - - subroutine psb_c_rsb_get_diag(a,d,info) - class(psb_c_rsb_sparse_mat), intent(in) :: a - complex(psb_spk_), intent(out) :: d(:) - integer, intent(out) :: info - !PSBRSB_DEBUG('') - info=rsb_getdiag(a%rsbmptr,d) - end subroutine psb_c_rsb_get_diag - -function psb_c_rsb_csnmi(a) result(csnmi_res) - implicit none - class(psb_c_rsb_sparse_mat), intent(in) :: a - real(psb_spk_),target :: csnmi_res ! please DO NOT rename this variable (see the Makefile) - complex(psb_spk_) :: resa(1) - integer :: info - !PSBRSB_DEBUG('') - info=rsb_infinity_norm(a%rsbmptr,resa,rsb_psblas_trans_to_rsb_trans('N')) - !info=rsb_infinity_norm(a%rsbmptr,c_loc(res),rsb_psblas_trans_to_rsb_trans('N')) - csnmi_res=resa(1) -end function psb_c_rsb_csnmi - -function psb_c_rsb_csnm1(a) result(res) - implicit none - class(psb_c_rsb_sparse_mat), intent(in) :: a - complex(psb_spk_) :: res - complex(psb_spk_) :: resa(1) - integer :: info - PSBRSB_DEBUG('') - info=rsb_one_norm(a%rsbmptr,resa,rsb_psblas_trans_to_rsb_trans('N')) - !info=rsb_one_norm(a%rsbmptr,res,rsb_psblas_trans_to_rsb_trans('N')) -end function psb_c_rsb_csnm1 - -subroutine psb_c_rsb_aclsum(d,a) - use psb_base_mod - class(psb_c_rsb_sparse_mat), intent(in) :: a - complex(psb_spk_), intent(out) :: d(:) - PSBRSB_DEBUG('') - info=rsb_absolute_columns_sums(a%rsbmptr,d) -end subroutine psb_c_rsb_aclsum - -subroutine psb_c_rsb_arwsum(d,a) - use psb_base_mod - class(psb_c_rsb_sparse_mat), intent(in) :: a - complex(psb_spk_), intent(out) :: d(:) - PSBRSB_DEBUG('') - info=rsb_absolute_rows_sums(a%rsbmptr,d) -end subroutine psb_c_rsb_arwsum - -subroutine psb_c_rsb_csmm(alpha,a,x,beta,y,info,trans) - use psb_base_mod - implicit none - class(psb_c_rsb_sparse_mat), intent(in) :: a - complex(psb_spk_), intent(in) :: alpha, beta, x(:,:) - complex(psb_spk_), intent(inout) :: y(:,:) - integer, intent(out) :: info - character, optional, intent(in) :: trans - - character :: trans_ - integer :: ldy,ldx,nc - PSBRSB_DEBUG('') - PSBRSB_DEBUG('ERROR: UNIMPLEMENTED') - - if (present(trans)) then - trans_ = trans - else - trans_ = 'N' - end if - ldx=size(x,1); ldy=size(y,1) - nc=min(size(x,2),size(y,2) ) - info=-1 - info=d_rsb_to_psb_info(rsb_spmm(rsb_psblas_trans_to_rsb_trans(trans_),alpha,a%rsbmptr,nc,c_f_order,x,ldx,beta,y,ldy)) -end subroutine psb_c_rsb_csmm - -subroutine psb_c_rsb_cssm(alpha,a,x,beta,y,info,trans) - use psb_base_mod - implicit none - class(psb_c_rsb_sparse_mat), intent(in) :: a - complex(psb_spk_), intent(in) :: alpha, beta, x(:,:) - complex(psb_spk_), intent(inout) :: y(:,:) - integer, intent(out) :: info - character, optional, intent(in) :: trans - integer :: ldy,ldx,nc - character :: trans_ - PSBRSB_DEBUG('') - PSBRSB_DEBUG('ERROR: UNIMPLEMENTED') - if (present(trans)) then - trans_ = trans - else - trans_ = 'N' - end if - ldx=size(x,1); ldy=size(y,1) - nc=min(size(x,2),size(y,2) ) - info=-1 - info=d_rsb_to_psb_info(rsb_spsm(rsb_psblas_trans_to_rsb_trans(trans_),alpha,a%rsbmptr,nc,c_f_order,beta,x,ldx,y,ldy)) -end subroutine - -subroutine psb_c_rsb_rowsum(d,a) - use psb_base_mod - class(psb_c_rsb_sparse_mat), intent(in) :: a - complex(psb_spk_), intent(out) :: d(:) - integer :: info - PSBRSB_DEBUG('') - info=d_rsb_to_psb_info(rsb_rows_sums(a%rsbmptr,d)) -end subroutine psb_c_rsb_rowsum - -subroutine psb_c_rsb_colsum(d,a) - use psb_base_mod - class(psb_c_rsb_sparse_mat), intent(in) :: a - complex(psb_spk_), intent(out) :: d(:) - integer :: info - PSBRSB_DEBUG('') - info=d_rsb_to_psb_info(rsb_columns_sums(a%rsbmptr,d)) -end subroutine psb_c_rsb_colsum - -subroutine psb_c_rsb_mold(a,b,info) - use psb_base_mod - implicit none - class(psb_c_rsb_sparse_mat), intent(in) :: a - class(psb_c_base_sparse_mat), intent(out), allocatable :: b - integer, intent(out) :: info - Integer :: err_act - character(len=20) :: name='reallocate_nz' - logical, parameter :: debug=.false. - PSBRSB_DEBUG('') - - call psb_get_erraction(err_act) - - allocate(psb_c_rsb_sparse_mat :: b, stat=info) - - if (info /= psb_success_) then - info = psb_err_alloc_dealloc_ - call psb_errpush(info, name) - goto 9999 - end if - return -9999 continue - if (err_act /= psb_act_ret_) then - PSBRSB_ERROR("!") - call psb_error() - end if - return -end subroutine psb_c_rsb_mold - -subroutine psb_c_rsb_reinit(a,clear) - implicit none - class(psb_c_rsb_sparse_mat), intent(inout) :: a - logical, intent(in), optional :: clear - Integer :: info - PSBRSB_DEBUG('') - info=d_rsb_to_psb_info(rsb_reinit_matrix(a%rsbmptr)) -end subroutine psb_c_rsb_reinit - - - function d_rsb_get_nz_row(idx,a) result(res) - implicit none - class(psb_c_rsb_sparse_mat), intent(in) :: a - integer, intent(in) :: idx - integer :: res - integer :: info - PSBRSB_DEBUG('') - res=0 - res=rsb_get_rows_nnz(a%rsbmptr,idx,idx,c_for_flags,info) - info=d_rsb_to_psb_info(info) - if(info.ne.0)res=0 - end function d_rsb_get_nz_row - -subroutine psb_c_cp_rsb_to_coo(a,b,info) - implicit none - class(psb_c_rsb_sparse_mat), intent(in) :: a - class(psb_c_coo_sparse_mat), intent(inout) :: b - integer, intent(out) :: info - - integer, allocatable :: itemp(:) - !locals - logical :: rwshr_ - Integer :: nza, nr, nc,i,j,irw, idl,err_act - integer :: debug_level, debug_unit - character(len=20) :: name - ! PSBRSB_DEBUG('') - info = psb_success_ - nr = a%get_nrows() - nc = a%get_ncols() - nza = a%get_nzeros() - call b%allocate(nr,nc,nza) - call b%psb_c_base_sparse_mat%cp_from(a%psb_c_base_sparse_mat) - info=d_rsb_to_psb_info(rsb_get_coo(a%rsbmptr,b%val,b%ia,b%ja,c_for_flags)) - call b%set_nzeros(a%get_nzeros()) - call b%set_nrows(a%get_nrows()) - call b%set_ncols(a%get_ncols()) - call b%fix(info) - !write(*,*)b%val - !write(*,*)b%ia - !write(*,*)b%ja - !write(*,*)b%get_nrows() - !write(*,*)b%get_ncols() - !write(*,*)b%get_nzeros() - !write(*,*)a%get_nrows() - !write(*,*)a%get_ncols() - !write(*,*)a%get_nzeros() -end subroutine psb_c_cp_rsb_to_coo - -subroutine psb_c_cp_rsb_to_fmt(a,b,info) - use psb_base_mod - implicit none - - class(psb_c_rsb_sparse_mat), intent(in) :: a - class(psb_c_base_sparse_mat), intent(inout) :: b - integer, intent(out) :: info - - !locals - type(psb_c_coo_sparse_mat) :: tmp - logical :: rwshr_ - Integer :: nza, nr, i,j,irw, idl,err_act, nc - integer :: debug_level, debug_unit - character(len=20) :: name - PSBRSB_DEBUG('') - - info = psb_success_ - - select type (b) - type is (psb_c_coo_sparse_mat) - call a%cp_to_coo(b,info) - - type is (psb_c_rsb_sparse_mat) - call b%psb_c_base_sparse_mat%cp_from(a%psb_c_base_sparse_mat)! FIXME: ? - b%rsbmptr=rsb_clone(a%rsbmptr) ! FIXME is thi enough ? - ! FIXME: error handling needed here - - class default - call a%cp_to_coo(tmp,info) - if (info == psb_success_) call b%mv_from_coo(tmp,info) - end select -end subroutine psb_c_cp_rsb_to_fmt - -subroutine psb_c_cp_rsb_from_coo(a,b,info) - use psb_base_mod - implicit none - - class(psb_c_rsb_sparse_mat), intent(inout) :: a - class(psb_c_coo_sparse_mat), intent(in) :: b - integer, intent(out) :: info - - integer, allocatable :: itemp(:) - !locals - logical :: rwshr_ - Integer :: nza, nr, i,j,irw, idl,err_act, nc - integer :: debug_level, debug_unit - integer :: flags - character(len=20) :: name - ! PSBRSB_DEBUG('') - - flags=d_rsb_get_flags(b) - - info = psb_success_ - call a%psb_c_base_sparse_mat%cp_from(b%psb_c_base_sparse_mat) - - !write (*,*) b%val - ! FIXME: and if sorted ? the process could be speeded up ! - a%rsbmptr=rsb_allocate_rsb_sparse_matrix_const& - &(b%val,b%ia,b%ja,b%get_nzeros(),c_typecode,b%get_nrows(),b%get_ncols(),1,1,flags,info) - info=d_rsb_to_psb_info(info) - ! FIXME: should destroy tmp ? -end subroutine psb_c_cp_rsb_from_coo - -subroutine psb_c_cp_rsb_from_fmt(a,b,info) - use psb_base_mod - implicit none - - class(psb_c_rsb_sparse_mat), intent(inout) :: a - class(psb_c_base_sparse_mat), intent(in) :: b - integer, intent(out) :: info - - !locals - type(psb_c_coo_sparse_mat) :: tmp - logical :: rwshr_ - Integer :: nz, nr, i,j,irw, idl,err_act, nc - integer :: debug_level, debug_unit - integer :: flags - character(len=20) :: name - PSBRSB_DEBUG('') - - info = psb_success_ - flags=d_rsb_get_flags(b) - - select type (b) - type is (psb_c_coo_sparse_mat) - call a%cp_from_coo(b,info) - - type is (psb_c_csr_sparse_mat) - call a%psb_c_base_sparse_mat%cp_from(b%psb_c_base_sparse_mat) - a%rsbmptr=rsb_allocate_rsb_sparse_matrix_from_csr_const& - &(b%val,b%irp,b%ja,b%get_nzeros(),c_typecode,b%get_nrows(),b%get_ncols(),1,1,flags,info) - info=d_rsb_to_psb_info(info) - - type is (psb_c_rsb_sparse_mat) - call b%cp_to_fmt(a,info) ! FIXME - ! FIXME: missing error handling - - class default - call b%cp_to_coo(tmp,info) - if (info == psb_success_) call a%mv_from_coo(tmp,info) - end select -end subroutine psb_c_cp_rsb_from_fmt - - -subroutine psb_c_rsb_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) - use psb_base_mod - implicit none - - class(psb_c_rsb_sparse_mat), intent(in) :: a - integer, intent(in) :: imin,imax - integer, intent(out) :: nz - integer, allocatable, intent(inout) :: ia(:), ja(:) - complex(psb_spk_), 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, nzrsb - character(len=20) :: name='csget' - logical, parameter :: debug=.false. - ! FIXME: MISSING THE HANDLING OF OPTIONS, HERE - PSBRSB_DEBUG('') - - call psb_erractionsave(err_act) - info = psb_success_ - - if (present(jmin)) then - jmin_ = jmin - else - jmin_ = 1 - endif - if (present(jmax)) then - jmax_ = jmax - else - jmax_ = a%get_ncols() - endif - - if ((imax d_rsb_get_size - procedure, pass(a) :: get_nzeros => d_rsb_get_nzeros - procedure, pass(a) :: get_ncols => d_rsb_get_ncols - procedure, pass(a) :: get_nrows => d_rsb_get_nrows - procedure, nopass :: get_fmt => d_rsb_get_fmt - procedure, pass(a) :: sizeof => d_rsb_sizeof - procedure, pass(a) :: d_csmm => psb_d_rsb_csmm - !procedure, pass(a) :: d_csmv_nt => psb_d_rsb_csmv_nt ! FIXME: a placeholder for future memory - procedure, pass(a) :: d_csmv => psb_d_rsb_csmv - procedure, pass(a) :: d_inner_cssm => psb_d_rsb_cssm - procedure, pass(a) :: d_inner_cssv => psb_d_rsb_cssv - procedure, pass(a) :: d_scals => psb_d_rsb_scals - procedure, pass(a) :: d_scal => psb_d_rsb_scal - procedure, pass(a) :: csnmi => psb_d_rsb_csnmi - procedure, pass(a) :: csnm1 => psb_d_rsb_csnm1 - procedure, pass(a) :: rowsum => psb_d_rsb_rowsum - procedure, pass(a) :: arwsum => psb_d_rsb_arwsum - procedure, pass(a) :: colsum => psb_d_rsb_colsum - procedure, pass(a) :: aclsum => psb_d_rsb_aclsum -! procedure, pass(a) :: reallocate_nz => psb_d_rsb_reallocate_nz ! FIXME -! procedure, pass(a) :: allocate_mnnz => psb_d_rsb_allocate_mnnz ! FIXME - procedure, pass(a) :: cp_to_coo => psb_d_cp_rsb_to_coo - procedure, pass(a) :: cp_from_coo => psb_d_cp_rsb_from_coo - procedure, pass(a) :: cp_to_fmt => psb_d_cp_rsb_to_fmt - procedure, pass(a) :: cp_from_fmt => psb_d_cp_rsb_from_fmt - procedure, pass(a) :: mv_to_coo => psb_d_mv_rsb_to_coo - procedure, pass(a) :: mv_from_coo => psb_d_mv_rsb_from_coo - procedure, pass(a) :: mv_to_fmt => psb_d_mv_rsb_to_fmt - procedure, pass(a) :: mv_from_fmt => psb_d_mv_rsb_from_fmt - procedure, pass(a) :: csput => psb_d_rsb_csput - procedure, pass(a) :: get_diag => psb_d_rsb_get_diag - procedure, pass(a) :: csgetptn => psb_d_rsb_csgetptn - procedure, pass(a) :: d_csgetrow => psb_d_rsb_csgetrow - procedure, pass(a) :: get_nz_row => d_rsb_get_nz_row - procedure, pass(a) :: reinit => psb_d_rsb_reinit - procedure, pass(a) :: trim => psb_d_rsb_trim ! evil - procedure, pass(a) :: print => psb_d_rsb_print - procedure, pass(a) :: free => d_rsb_free - procedure, pass(a) :: mold => psb_d_rsb_mold - procedure, pass(a) :: psb_d_rsb_cp_from - generic, public :: cp_from => psb_d_rsb_cp_from - procedure, pass(a) :: psb_d_rsb_mv_from - generic, public :: mv_from => psb_d_rsb_mv_from - -#endif - end type psb_d_rsb_sparse_mat - ! FIXME: complete the following - !private :: d_rsb_get_nzeros, d_rsb_get_fmt - private :: d_rsb_to_psb_info -#ifdef HAVE_LIBRSB - contains - - function psb_rsb_matmod_init() result(res) - implicit none - integer :: res - !PSBRSB_DEBUG('') - res=-1 ! FIXME -#ifdef HAVE_LIBRSB - res=d_rsb_to_psb_info(rsb_init(c_null_ptr)) -#endif - end function psb_rsb_matmod_init - - function psb_rsb_matmod_exit() result(res) - implicit none - integer :: res - !PSBRSB_DEBUG('') - res=-1 ! FIXME -#ifdef HAVE_LIBRSB - res=d_rsb_to_psb_info(rsb_exit()) -#endif - end function psb_rsb_matmod_exit - - function d_rsb_to_psb_info(info) result(res) - implicit none - integer , intent(in) :: info - integer :: res - !PSBRSB_DEBUG('') - if(info.ne.0)then - res=-1 - else - res=psb_success_ - end if - end function d_rsb_to_psb_info - - function d_rsb_get_flags(a) result(flags) - implicit none - integer :: flags - class(psb_d_base_sparse_mat), intent(in) :: a - !PSBRSB_DEBUG('') - flags=c_def_flags - if(a%is_sorted()) flags=flags+c_srt_flags - if(a%is_triangle()) flags=flags+c_tri_flags - if(a%is_upper()) flags=flags+c_upp_flags - if(a%is_unit()) flags=flags+c_idi_flags - if(a%is_lower()) flags=flags+c_low_flags - end function d_rsb_get_flags - - function d_rsb_get_nzeros(a) result(res) - implicit none - class(psb_d_rsb_sparse_mat), intent(in) :: a - integer :: res - !PSBRSB_DEBUG('') - res=rsb_get_matrix_nnz(a%rsbmptr) - end function d_rsb_get_nzeros - - function d_rsb_get_nrows(a) result(res) - implicit none - class(psb_d_rsb_sparse_mat), intent(in) :: a - integer :: res - !PSBRSB_DEBUG('') - res=rsb_get_matrix_n_rows(a%rsbmptr) - end function d_rsb_get_nrows - - function d_rsb_get_ncols(a) result(res) - implicit none - class(psb_d_rsb_sparse_mat), intent(in) :: a - integer :: res - !PSBRSB_DEBUG('') - res=rsb_get_matrix_n_columns(a%rsbmptr) - end function d_rsb_get_ncols - - function d_rsb_get_fmt() result(res) - implicit none - character(len=5) :: res - !the following printout is harmful, here, if happening during a write :) (causes a deadlock) - !PSBRSB_DEBUG('') - res = 'RSB' - end function d_rsb_get_fmt - - function d_rsb_get_size(a) result(res) - implicit none - class(psb_d_rsb_sparse_mat), intent(in) :: a - integer :: res - !PSBRSB_DEBUG('') - res = d_rsb_get_nzeros(a) - end function d_rsb_get_size - - function d_rsb_sizeof(a) result(res) - implicit none - class(psb_d_rsb_sparse_mat), intent(in) :: a - integer(psb_long_int_k_) :: res - !PSBRSB_DEBUG('') - res=rsb_sizeof(a%rsbmptr) - end function d_rsb_sizeof - -subroutine psb_d_rsb_csmv(alpha,a,x,beta,y,info,trans) - implicit none - class(psb_d_rsb_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_ -! PSBRSB_DEBUG('') - info = psb_success_ - - if (present(trans)) then - trans_ = trans - else - trans_ = 'N' - end if - info=d_rsb_to_psb_info(rsb_spmv(rsb_psblas_trans_to_rsb_trans(trans_),alpha,a%rsbmptr,x,1,beta,y,1)) -end subroutine psb_d_rsb_csmv - -subroutine psb_d_rsb_csmv_nt(alpha,a,x1,x2,beta,y1,y2,info) - ! FIXME: this routine is here as a placeholder for a specialized implementation of - ! joint spmv and spmv transposed. - implicit none - class(psb_d_rsb_sparse_mat), intent(in) :: a - real(psb_dpk_), intent(in) :: alpha, beta, x1(:), x2(:) - real(psb_dpk_), intent(inout) :: y1(:), y2(:) - integer, intent(out) :: info -! PSBRSB_DEBUG('') - info = psb_success_ - info=d_rsb_to_psb_info(rsb_spmv_nt(alpha,a%rsbmptr,x1,x2,1,beta,y1,y2,1)) - return -end subroutine psb_d_rsb_csmv_nt - -subroutine psb_d_rsb_cssv(alpha,a,x,beta,y,info,trans) - use psb_error_mod - ! FIXME: and what when x is an alias of y ? - ! FIXME: ignoring beta - implicit none - class(psb_d_rsb_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 :: err_act, i - character(len=20) :: name='rsb_cssv' - logical, parameter :: debug=.false. - - info = psb_success_ - call psb_erractionsave(err_act) - -! PSBRSB_DEBUG('') - - if (present(trans)) then - trans_ = trans - else - trans_ = 'N' - end if - info=d_rsb_to_psb_info(rsb_spsv(rsb_psblas_trans_to_rsb_trans(trans_),alpha,a%rsbmptr,x,1,y,1)) - if (info /= 0) then - i = info - info = psb_err_from_subroutine_ai_ - call psb_errpush(info,name,& - & i_err=(/i,0,0,0,0/),a_err="rsb_spsv") - goto 9999 - end if - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - - if (err_act == psb_act_abort_) then - PSBRSB_ERROR("!") - call psb_error() - return - end if - return - -end subroutine psb_d_rsb_cssv - -subroutine psb_d_rsb_scals(d,a,info) - use psb_base_mod - implicit none - class(psb_d_rsb_sparse_mat), intent(inout) :: a - real(psb_dpk_), intent(in) :: d - integer, intent(out) :: info - PSBRSB_DEBUG('') - info=d_rsb_to_psb_info(rsb_elemental_scale(a%rsbmptr,d)) -end subroutine psb_d_rsb_scals - -subroutine psb_d_rsb_scal(d,a,info) - use psb_base_mod - implicit none - class(psb_d_rsb_sparse_mat), intent(inout) :: a - real(psb_dpk_), intent(in) :: d(:) - integer, intent(out) :: info - PSBRSB_DEBUG('') - info=d_rsb_to_psb_info(rsb_scale_rows(a%rsbmptr,d)) -end subroutine psb_d_rsb_scal - - subroutine d_rsb_free(a) - implicit none - class(psb_d_rsb_sparse_mat), intent(inout) :: a - type(c_ptr) :: dummy - !PSBRSB_DEBUG('freeing RSB matrix') - dummy=rsb_free_sparse_matrix(a%rsbmptr) - end subroutine d_rsb_free - -subroutine psb_d_rsb_trim(a) - implicit none - class(psb_d_rsb_sparse_mat), intent(inout) :: a - !PSBRSB_DEBUG('') - ! FIXME: this is supposed to remain empty for RSB -end subroutine psb_d_rsb_trim - - subroutine psb_d_rsb_print(iout,a,iv,eirs,eics,head,ivr,ivc) - integer, intent(in) :: iout - class(psb_d_rsb_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 :: info - PSBRSB_DEBUG('') - ! FIXME: UNFINISHED - info=rsb_print_matrix_t(a%rsbmptr) - end subroutine psb_d_rsb_print - - subroutine psb_d_rsb_get_diag(a,d,info) - class(psb_d_rsb_sparse_mat), intent(in) :: a - real(psb_dpk_), intent(out) :: d(:) - integer, intent(out) :: info - !PSBRSB_DEBUG('') - info=rsb_getdiag(a%rsbmptr,d) - end subroutine psb_d_rsb_get_diag - -function psb_d_rsb_csnmi(a) result(csnmi_res) - implicit none - class(psb_d_rsb_sparse_mat), intent(in) :: a - real(psb_dpk_),target :: csnmi_res ! please DO NOT rename this variable (see the Makefile) - real(psb_dpk_) :: resa(1) - integer :: info - !PSBRSB_DEBUG('') - info=rsb_infinity_norm(a%rsbmptr,resa,rsb_psblas_trans_to_rsb_trans('N')) - !info=rsb_infinity_norm(a%rsbmptr,c_loc(res),rsb_psblas_trans_to_rsb_trans('N')) - csnmi_res=resa(1) -end function psb_d_rsb_csnmi - -function psb_d_rsb_csnm1(a) result(res) - implicit none - class(psb_d_rsb_sparse_mat), intent(in) :: a - real(psb_dpk_) :: res - real(psb_dpk_) :: resa(1) - integer :: info - PSBRSB_DEBUG('') - info=rsb_one_norm(a%rsbmptr,resa,rsb_psblas_trans_to_rsb_trans('N')) - !info=rsb_one_norm(a%rsbmptr,res,rsb_psblas_trans_to_rsb_trans('N')) -end function psb_d_rsb_csnm1 - -subroutine psb_d_rsb_aclsum(d,a) - use psb_base_mod - class(psb_d_rsb_sparse_mat), intent(in) :: a - real(psb_dpk_), intent(out) :: d(:) - PSBRSB_DEBUG('') - info=rsb_absolute_columns_sums(a%rsbmptr,d) -end subroutine psb_d_rsb_aclsum - -subroutine psb_d_rsb_arwsum(d,a) - use psb_base_mod - class(psb_d_rsb_sparse_mat), intent(in) :: a - real(psb_dpk_), intent(out) :: d(:) - PSBRSB_DEBUG('') - info=rsb_absolute_rows_sums(a%rsbmptr,d) -end subroutine psb_d_rsb_arwsum - -subroutine psb_d_rsb_csmm(alpha,a,x,beta,y,info,trans) - use psb_base_mod - implicit none - class(psb_d_rsb_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 :: ldy,ldx,nc - PSBRSB_DEBUG('') - PSBRSB_DEBUG('ERROR: UNIMPLEMENTED') - - if (present(trans)) then - trans_ = trans - else - trans_ = 'N' - end if - ldx=size(x,1); ldy=size(y,1) - nc=min(size(x,2),size(y,2) ) - info=-1 - info=d_rsb_to_psb_info(rsb_spmm(rsb_psblas_trans_to_rsb_trans(trans_),alpha,a%rsbmptr,nc,c_f_order,x,ldx,beta,y,ldy)) -end subroutine psb_d_rsb_csmm - -subroutine psb_d_rsb_cssm(alpha,a,x,beta,y,info,trans) - use psb_base_mod - implicit none - class(psb_d_rsb_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 - integer :: ldy,ldx,nc - character :: trans_ - PSBRSB_DEBUG('') - PSBRSB_DEBUG('ERROR: UNIMPLEMENTED') - if (present(trans)) then - trans_ = trans - else - trans_ = 'N' - end if - ldx=size(x,1); ldy=size(y,1) - nc=min(size(x,2),size(y,2) ) - info=-1 - info=d_rsb_to_psb_info(rsb_spsm(rsb_psblas_trans_to_rsb_trans(trans_),alpha,a%rsbmptr,nc,c_f_order,beta,x,ldx,y,ldy)) -end subroutine - -subroutine psb_d_rsb_rowsum(d,a) - use psb_base_mod - class(psb_d_rsb_sparse_mat), intent(in) :: a - real(psb_dpk_), intent(out) :: d(:) - integer :: info - PSBRSB_DEBUG('') - info=d_rsb_to_psb_info(rsb_rows_sums(a%rsbmptr,d)) -end subroutine psb_d_rsb_rowsum - -subroutine psb_d_rsb_colsum(d,a) - use psb_base_mod - class(psb_d_rsb_sparse_mat), intent(in) :: a - real(psb_dpk_), intent(out) :: d(:) - integer :: info - PSBRSB_DEBUG('') - info=d_rsb_to_psb_info(rsb_columns_sums(a%rsbmptr,d)) -end subroutine psb_d_rsb_colsum - -subroutine psb_d_rsb_mold(a,b,info) - use psb_base_mod - implicit none - class(psb_d_rsb_sparse_mat), intent(in) :: a - class(psb_d_base_sparse_mat), intent(out), allocatable :: b - integer, intent(out) :: info - Integer :: err_act - character(len=20) :: name='reallocate_nz' - logical, parameter :: debug=.false. - PSBRSB_DEBUG('') - - call psb_get_erraction(err_act) - - allocate(psb_d_rsb_sparse_mat :: b, stat=info) - - if (info /= psb_success_) then - info = psb_err_alloc_dealloc_ - call psb_errpush(info, name) - goto 9999 - end if - return -9999 continue - if (err_act /= psb_act_ret_) then - PSBRSB_ERROR("!") - call psb_error() - end if - return -end subroutine psb_d_rsb_mold - -subroutine psb_d_rsb_reinit(a,clear) - implicit none - class(psb_d_rsb_sparse_mat), intent(inout) :: a - logical, intent(in), optional :: clear - Integer :: info - PSBRSB_DEBUG('') - info=d_rsb_to_psb_info(rsb_reinit_matrix(a%rsbmptr)) -end subroutine psb_d_rsb_reinit - - - function d_rsb_get_nz_row(idx,a) result(res) - implicit none - class(psb_d_rsb_sparse_mat), intent(in) :: a - integer, intent(in) :: idx - integer :: res - integer :: info - PSBRSB_DEBUG('') - res=0 - res=rsb_get_rows_nnz(a%rsbmptr,idx,idx,c_for_flags,info) - info=d_rsb_to_psb_info(info) - if(info.ne.0)res=0 - end function d_rsb_get_nz_row - -subroutine psb_d_cp_rsb_to_coo(a,b,info) - implicit none - class(psb_d_rsb_sparse_mat), intent(in) :: a - class(psb_d_coo_sparse_mat), intent(inout) :: b - integer, intent(out) :: info - - integer, allocatable :: itemp(:) - !locals - logical :: rwshr_ - Integer :: nza, nr, nc,i,j,irw, idl,err_act - integer :: debug_level, debug_unit - character(len=20) :: name - ! PSBRSB_DEBUG('') - info = psb_success_ - nr = a%get_nrows() - nc = a%get_ncols() - nza = a%get_nzeros() - call b%allocate(nr,nc,nza) - call b%psb_d_base_sparse_mat%cp_from(a%psb_d_base_sparse_mat) - info=d_rsb_to_psb_info(rsb_get_coo(a%rsbmptr,b%val,b%ia,b%ja,c_for_flags)) - call b%set_nzeros(a%get_nzeros()) - call b%set_nrows(a%get_nrows()) - call b%set_ncols(a%get_ncols()) - call b%fix(info) - !write(*,*)b%val - !write(*,*)b%ia - !write(*,*)b%ja - !write(*,*)b%get_nrows() - !write(*,*)b%get_ncols() - !write(*,*)b%get_nzeros() - !write(*,*)a%get_nrows() - !write(*,*)a%get_ncols() - !write(*,*)a%get_nzeros() -end subroutine psb_d_cp_rsb_to_coo - -subroutine psb_d_cp_rsb_to_fmt(a,b,info) - use psb_base_mod - implicit none - - class(psb_d_rsb_sparse_mat), intent(in) :: a - class(psb_d_base_sparse_mat), intent(inout) :: b - integer, intent(out) :: info - - !locals - type(psb_d_coo_sparse_mat) :: tmp - logical :: rwshr_ - Integer :: nza, nr, i,j,irw, idl,err_act, nc - integer :: debug_level, debug_unit - character(len=20) :: name - PSBRSB_DEBUG('') - - info = psb_success_ - - select type (b) - type is (psb_d_coo_sparse_mat) - call a%cp_to_coo(b,info) - - type is (psb_d_rsb_sparse_mat) - call b%psb_d_base_sparse_mat%cp_from(a%psb_d_base_sparse_mat)! FIXME: ? - b%rsbmptr=rsb_clone(a%rsbmptr) ! FIXME is thi enough ? - ! FIXME: error handling needed here - - class default - call a%cp_to_coo(tmp,info) - if (info == psb_success_) call b%mv_from_coo(tmp,info) - end select -end subroutine psb_d_cp_rsb_to_fmt - -subroutine psb_d_cp_rsb_from_coo(a,b,info) - use psb_base_mod - implicit none - - class(psb_d_rsb_sparse_mat), intent(inout) :: a - class(psb_d_coo_sparse_mat), intent(in) :: b - integer, intent(out) :: info - - integer, allocatable :: itemp(:) - !locals - logical :: rwshr_ - Integer :: nza, nr, i,j,irw, idl,err_act, nc - integer :: debug_level, debug_unit - integer :: flags - character(len=20) :: name - ! PSBRSB_DEBUG('') - - flags=d_rsb_get_flags(b) - - info = psb_success_ - call a%psb_d_base_sparse_mat%cp_from(b%psb_d_base_sparse_mat) - - !write (*,*) b%val - ! FIXME: and if sorted ? the process could be speeded up ! - a%rsbmptr=rsb_allocate_rsb_sparse_matrix_const& - &(b%val,b%ia,b%ja,b%get_nzeros(),c_typecode,b%get_nrows(),b%get_ncols(),1,1,flags,info) - info=d_rsb_to_psb_info(info) - ! FIXME: should destroy tmp ? -end subroutine psb_d_cp_rsb_from_coo - -subroutine psb_d_cp_rsb_from_fmt(a,b,info) - use psb_base_mod - implicit none - - class(psb_d_rsb_sparse_mat), intent(inout) :: a - class(psb_d_base_sparse_mat), intent(in) :: b - integer, intent(out) :: info - - !locals - type(psb_d_coo_sparse_mat) :: tmp - logical :: rwshr_ - Integer :: nz, nr, i,j,irw, idl,err_act, nc - integer :: debug_level, debug_unit - integer :: flags - character(len=20) :: name - PSBRSB_DEBUG('') - - info = psb_success_ - flags=d_rsb_get_flags(b) - - select type (b) - type is (psb_d_coo_sparse_mat) - call a%cp_from_coo(b,info) - - type is (psb_d_csr_sparse_mat) - call a%psb_d_base_sparse_mat%cp_from(b%psb_d_base_sparse_mat) - a%rsbmptr=rsb_allocate_rsb_sparse_matrix_from_csr_const& - &(b%val,b%irp,b%ja,b%get_nzeros(),c_typecode,b%get_nrows(),b%get_ncols(),1,1,flags,info) - info=d_rsb_to_psb_info(info) - - type is (psb_d_rsb_sparse_mat) - call b%cp_to_fmt(a,info) ! FIXME - ! FIXME: missing error handling - - class default - call b%cp_to_coo(tmp,info) - if (info == psb_success_) call a%mv_from_coo(tmp,info) - end select -end subroutine psb_d_cp_rsb_from_fmt - - -subroutine psb_d_rsb_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) - use psb_base_mod - implicit none - - class(psb_d_rsb_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, nzrsb - character(len=20) :: name='csget' - logical, parameter :: debug=.false. - ! FIXME: MISSING THE HANDLING OF OPTIONS, HERE - PSBRSB_DEBUG('') - - call psb_erractionsave(err_act) - info = psb_success_ - - if (present(jmin)) then - jmin_ = jmin - else - jmin_ = 1 - endif - if (present(jmax)) then - jmax_ = jmax - else - jmax_ = a%get_ncols() - endif - - if ((imax d_rsb_get_size - procedure, pass(a) :: get_nzeros => d_rsb_get_nzeros - procedure, pass(a) :: get_ncols => d_rsb_get_ncols - procedure, pass(a) :: get_nrows => d_rsb_get_nrows - procedure, nopass :: get_fmt => d_rsb_get_fmt - procedure, pass(a) :: sizeof => d_rsb_sizeof - procedure, pass(a) :: d_csmm => psb_s_rsb_csmm - !procedure, pass(a) :: d_csmv_nt => psb_s_rsb_csmv_nt ! FIXME: a placeholder for future memory - procedure, pass(a) :: d_csmv => psb_s_rsb_csmv - procedure, pass(a) :: d_inner_cssm => psb_s_rsb_cssm - procedure, pass(a) :: d_inner_cssv => psb_s_rsb_cssv - procedure, pass(a) :: d_scals => psb_s_rsb_scals - procedure, pass(a) :: d_scal => psb_s_rsb_scal - procedure, pass(a) :: csnmi => psb_s_rsb_csnmi - procedure, pass(a) :: csnm1 => psb_s_rsb_csnm1 - procedure, pass(a) :: rowsum => psb_s_rsb_rowsum - procedure, pass(a) :: arwsum => psb_s_rsb_arwsum - procedure, pass(a) :: colsum => psb_s_rsb_colsum - procedure, pass(a) :: aclsum => psb_s_rsb_aclsum -! procedure, pass(a) :: reallocate_nz => psb_s_rsb_reallocate_nz ! FIXME -! procedure, pass(a) :: allocate_mnnz => psb_s_rsb_allocate_mnnz ! FIXME - procedure, pass(a) :: cp_to_coo => psb_s_cp_rsb_to_coo - procedure, pass(a) :: cp_from_coo => psb_s_cp_rsb_from_coo - procedure, pass(a) :: cp_to_fmt => psb_s_cp_rsb_to_fmt - procedure, pass(a) :: cp_from_fmt => psb_s_cp_rsb_from_fmt - procedure, pass(a) :: mv_to_coo => psb_s_mv_rsb_to_coo - procedure, pass(a) :: mv_from_coo => psb_s_mv_rsb_from_coo - procedure, pass(a) :: mv_to_fmt => psb_s_mv_rsb_to_fmt - procedure, pass(a) :: mv_from_fmt => psb_s_mv_rsb_from_fmt - procedure, pass(a) :: csput => psb_s_rsb_csput - procedure, pass(a) :: get_diag => psb_s_rsb_get_diag - procedure, pass(a) :: csgetptn => psb_s_rsb_csgetptn - procedure, pass(a) :: d_csgetrow => psb_s_rsb_csgetrow - procedure, pass(a) :: get_nz_row => d_rsb_get_nz_row - procedure, pass(a) :: reinit => psb_s_rsb_reinit - procedure, pass(a) :: trim => psb_s_rsb_trim ! evil - procedure, pass(a) :: print => psb_s_rsb_print - procedure, pass(a) :: free => d_rsb_free - procedure, pass(a) :: mold => psb_s_rsb_mold - procedure, pass(a) :: psb_s_rsb_cp_from - generic, public :: cp_from => psb_s_rsb_cp_from - procedure, pass(a) :: psb_s_rsb_mv_from - generic, public :: mv_from => psb_s_rsb_mv_from - -#endif - end type psb_s_rsb_sparse_mat - ! FIXME: complete the following - !private :: d_rsb_get_nzeros, d_rsb_get_fmt - private :: d_rsb_to_psb_info -#ifdef HAVE_LIBRSB - contains - - function psb_rsb_matmod_init() result(res) - implicit none - integer :: res - !PSBRSB_DEBUG('') - res=-1 ! FIXME -#ifdef HAVE_LIBRSB - res=d_rsb_to_psb_info(rsb_init(c_null_ptr)) -#endif - end function psb_rsb_matmod_init - - function psb_rsb_matmod_exit() result(res) - implicit none - integer :: res - !PSBRSB_DEBUG('') - res=-1 ! FIXME -#ifdef HAVE_LIBRSB - res=d_rsb_to_psb_info(rsb_exit()) -#endif - end function psb_rsb_matmod_exit - - function d_rsb_to_psb_info(info) result(res) - implicit none - integer , intent(in) :: info - integer :: res - !PSBRSB_DEBUG('') - if(info.ne.0)then - res=-1 - else - res=psb_success_ - end if - end function d_rsb_to_psb_info - - function d_rsb_get_flags(a) result(flags) - implicit none - integer :: flags - class(psb_s_base_sparse_mat), intent(in) :: a - !PSBRSB_DEBUG('') - flags=c_def_flags - if(a%is_sorted()) flags=flags+c_srt_flags - if(a%is_triangle()) flags=flags+c_tri_flags - if(a%is_upper()) flags=flags+c_upp_flags - if(a%is_unit()) flags=flags+c_idi_flags - if(a%is_lower()) flags=flags+c_low_flags - end function d_rsb_get_flags - - function d_rsb_get_nzeros(a) result(res) - implicit none - class(psb_s_rsb_sparse_mat), intent(in) :: a - integer :: res - !PSBRSB_DEBUG('') - res=rsb_get_matrix_nnz(a%rsbmptr) - end function d_rsb_get_nzeros - - function d_rsb_get_nrows(a) result(res) - implicit none - class(psb_s_rsb_sparse_mat), intent(in) :: a - integer :: res - !PSBRSB_DEBUG('') - res=rsb_get_matrix_n_rows(a%rsbmptr) - end function d_rsb_get_nrows - - function d_rsb_get_ncols(a) result(res) - implicit none - class(psb_s_rsb_sparse_mat), intent(in) :: a - integer :: res - !PSBRSB_DEBUG('') - res=rsb_get_matrix_n_columns(a%rsbmptr) - end function d_rsb_get_ncols - - function d_rsb_get_fmt() result(res) - implicit none - character(len=5) :: res - !the following printout is harmful, here, if happening during a write :) (causes a deadlock) - !PSBRSB_DEBUG('') - res = 'RSB' - end function d_rsb_get_fmt - - function d_rsb_get_size(a) result(res) - implicit none - class(psb_s_rsb_sparse_mat), intent(in) :: a - integer :: res - !PSBRSB_DEBUG('') - res = d_rsb_get_nzeros(a) - end function d_rsb_get_size - - function d_rsb_sizeof(a) result(res) - implicit none - class(psb_s_rsb_sparse_mat), intent(in) :: a - integer(psb_long_int_k_) :: res - !PSBRSB_DEBUG('') - res=rsb_sizeof(a%rsbmptr) - end function d_rsb_sizeof - -subroutine psb_s_rsb_csmv(alpha,a,x,beta,y,info,trans) - implicit none - class(psb_s_rsb_sparse_mat), intent(in) :: a - real(psb_spk_), intent(in) :: alpha, beta, x(:) - real(psb_spk_), intent(inout) :: y(:) - integer, intent(out) :: info - character, optional, intent(in) :: trans - character :: trans_ -! PSBRSB_DEBUG('') - info = psb_success_ - - if (present(trans)) then - trans_ = trans - else - trans_ = 'N' - end if - info=d_rsb_to_psb_info(rsb_spmv(rsb_psblas_trans_to_rsb_trans(trans_),alpha,a%rsbmptr,x,1,beta,y,1)) -end subroutine psb_s_rsb_csmv - -subroutine psb_s_rsb_csmv_nt(alpha,a,x1,x2,beta,y1,y2,info) - ! FIXME: this routine is here as a placeholder for a specialized implementation of - ! joint spmv and spmv transposed. - implicit none - class(psb_s_rsb_sparse_mat), intent(in) :: a - real(psb_spk_), intent(in) :: alpha, beta, x1(:), x2(:) - real(psb_spk_), intent(inout) :: y1(:), y2(:) - integer, intent(out) :: info -! PSBRSB_DEBUG('') - info = psb_success_ - info=d_rsb_to_psb_info(rsb_spmv_nt(alpha,a%rsbmptr,x1,x2,1,beta,y1,y2,1)) - return -end subroutine psb_s_rsb_csmv_nt - -subroutine psb_s_rsb_cssv(alpha,a,x,beta,y,info,trans) - use psb_error_mod - ! FIXME: and what when x is an alias of y ? - ! FIXME: ignoring beta - implicit none - class(psb_s_rsb_sparse_mat), intent(in) :: a - real(psb_spk_), intent(in) :: alpha, beta, x(:) - real(psb_spk_), intent(inout) :: y(:) - integer, intent(out) :: info - character, optional, intent(in) :: trans - character :: trans_ - Integer :: err_act, i - character(len=20) :: name='rsb_cssv' - logical, parameter :: debug=.false. - - info = psb_success_ - call psb_erractionsave(err_act) - -! PSBRSB_DEBUG('') - - if (present(trans)) then - trans_ = trans - else - trans_ = 'N' - end if - info=d_rsb_to_psb_info(rsb_spsv(rsb_psblas_trans_to_rsb_trans(trans_),alpha,a%rsbmptr,x,1,y,1)) - if (info /= 0) then - i = info - info = psb_err_from_subroutine_ai_ - call psb_errpush(info,name,& - & i_err=(/i,0,0,0,0/),a_err="rsb_spsv") - goto 9999 - end if - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - - if (err_act == psb_act_abort_) then - PSBRSB_ERROR("!") - call psb_error() - return - end if - return - -end subroutine psb_s_rsb_cssv - -subroutine psb_s_rsb_scals(d,a,info) - use psb_base_mod - implicit none - class(psb_s_rsb_sparse_mat), intent(inout) :: a - real(psb_spk_), intent(in) :: d - integer, intent(out) :: info - PSBRSB_DEBUG('') - info=d_rsb_to_psb_info(rsb_elemental_scale(a%rsbmptr,d)) -end subroutine psb_s_rsb_scals - -subroutine psb_s_rsb_scal(d,a,info) - use psb_base_mod - implicit none - class(psb_s_rsb_sparse_mat), intent(inout) :: a - real(psb_spk_), intent(in) :: d(:) - integer, intent(out) :: info - PSBRSB_DEBUG('') - info=d_rsb_to_psb_info(rsb_scale_rows(a%rsbmptr,d)) -end subroutine psb_s_rsb_scal - - subroutine d_rsb_free(a) - implicit none - class(psb_s_rsb_sparse_mat), intent(inout) :: a - type(c_ptr) :: dummy - !PSBRSB_DEBUG('freeing RSB matrix') - dummy=rsb_free_sparse_matrix(a%rsbmptr) - end subroutine d_rsb_free - -subroutine psb_s_rsb_trim(a) - implicit none - class(psb_s_rsb_sparse_mat), intent(inout) :: a - !PSBRSB_DEBUG('') - ! FIXME: this is supposed to remain empty for RSB -end subroutine psb_s_rsb_trim - - subroutine psb_s_rsb_print(iout,a,iv,eirs,eics,head,ivr,ivc) - integer, intent(in) :: iout - class(psb_s_rsb_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 :: info - PSBRSB_DEBUG('') - ! FIXME: UNFINISHED - info=rsb_print_matrix_t(a%rsbmptr) - end subroutine psb_s_rsb_print - - subroutine psb_s_rsb_get_diag(a,d,info) - class(psb_s_rsb_sparse_mat), intent(in) :: a - real(psb_spk_), intent(out) :: d(:) - integer, intent(out) :: info - !PSBRSB_DEBUG('') - info=rsb_getdiag(a%rsbmptr,d) - end subroutine psb_s_rsb_get_diag - -function psb_s_rsb_csnmi(a) result(csnmi_res) - implicit none - class(psb_s_rsb_sparse_mat), intent(in) :: a - real(psb_spk_),target :: csnmi_res ! please DO NOT rename this variable (see the Makefile) - real(psb_spk_) :: resa(1) - integer :: info - !PSBRSB_DEBUG('') - info=rsb_infinity_norm(a%rsbmptr,resa,rsb_psblas_trans_to_rsb_trans('N')) - !info=rsb_infinity_norm(a%rsbmptr,c_loc(res),rsb_psblas_trans_to_rsb_trans('N')) - csnmi_res=resa(1) -end function psb_s_rsb_csnmi - -function psb_s_rsb_csnm1(a) result(res) - implicit none - class(psb_s_rsb_sparse_mat), intent(in) :: a - real(psb_spk_) :: res - real(psb_spk_) :: resa(1) - integer :: info - PSBRSB_DEBUG('') - info=rsb_one_norm(a%rsbmptr,resa,rsb_psblas_trans_to_rsb_trans('N')) - !info=rsb_one_norm(a%rsbmptr,res,rsb_psblas_trans_to_rsb_trans('N')) -end function psb_s_rsb_csnm1 - -subroutine psb_s_rsb_aclsum(d,a) - use psb_base_mod - class(psb_s_rsb_sparse_mat), intent(in) :: a - real(psb_spk_), intent(out) :: d(:) - PSBRSB_DEBUG('') - info=rsb_absolute_columns_sums(a%rsbmptr,d) -end subroutine psb_s_rsb_aclsum - -subroutine psb_s_rsb_arwsum(d,a) - use psb_base_mod - class(psb_s_rsb_sparse_mat), intent(in) :: a - real(psb_spk_), intent(out) :: d(:) - PSBRSB_DEBUG('') - info=rsb_absolute_rows_sums(a%rsbmptr,d) -end subroutine psb_s_rsb_arwsum - -subroutine psb_s_rsb_csmm(alpha,a,x,beta,y,info,trans) - use psb_base_mod - implicit none - class(psb_s_rsb_sparse_mat), intent(in) :: a - real(psb_spk_), intent(in) :: alpha, beta, x(:,:) - real(psb_spk_), intent(inout) :: y(:,:) - integer, intent(out) :: info - character, optional, intent(in) :: trans - - character :: trans_ - integer :: ldy,ldx,nc - PSBRSB_DEBUG('') - PSBRSB_DEBUG('ERROR: UNIMPLEMENTED') - - if (present(trans)) then - trans_ = trans - else - trans_ = 'N' - end if - ldx=size(x,1); ldy=size(y,1) - nc=min(size(x,2),size(y,2) ) - info=-1 - info=d_rsb_to_psb_info(rsb_spmm(rsb_psblas_trans_to_rsb_trans(trans_),alpha,a%rsbmptr,nc,c_f_order,x,ldx,beta,y,ldy)) -end subroutine psb_s_rsb_csmm - -subroutine psb_s_rsb_cssm(alpha,a,x,beta,y,info,trans) - use psb_base_mod - implicit none - class(psb_s_rsb_sparse_mat), intent(in) :: a - real(psb_spk_), intent(in) :: alpha, beta, x(:,:) - real(psb_spk_), intent(inout) :: y(:,:) - integer, intent(out) :: info - character, optional, intent(in) :: trans - integer :: ldy,ldx,nc - character :: trans_ - PSBRSB_DEBUG('') - PSBRSB_DEBUG('ERROR: UNIMPLEMENTED') - if (present(trans)) then - trans_ = trans - else - trans_ = 'N' - end if - ldx=size(x,1); ldy=size(y,1) - nc=min(size(x,2),size(y,2) ) - info=-1 - info=d_rsb_to_psb_info(rsb_spsm(rsb_psblas_trans_to_rsb_trans(trans_),alpha,a%rsbmptr,nc,c_f_order,beta,x,ldx,y,ldy)) -end subroutine - -subroutine psb_s_rsb_rowsum(d,a) - use psb_base_mod - class(psb_s_rsb_sparse_mat), intent(in) :: a - real(psb_spk_), intent(out) :: d(:) - integer :: info - PSBRSB_DEBUG('') - info=d_rsb_to_psb_info(rsb_rows_sums(a%rsbmptr,d)) -end subroutine psb_s_rsb_rowsum - -subroutine psb_s_rsb_colsum(d,a) - use psb_base_mod - class(psb_s_rsb_sparse_mat), intent(in) :: a - real(psb_spk_), intent(out) :: d(:) - integer :: info - PSBRSB_DEBUG('') - info=d_rsb_to_psb_info(rsb_columns_sums(a%rsbmptr,d)) -end subroutine psb_s_rsb_colsum - -subroutine psb_s_rsb_mold(a,b,info) - use psb_base_mod - implicit none - class(psb_s_rsb_sparse_mat), intent(in) :: a - class(psb_s_base_sparse_mat), intent(out), allocatable :: b - integer, intent(out) :: info - Integer :: err_act - character(len=20) :: name='reallocate_nz' - logical, parameter :: debug=.false. - PSBRSB_DEBUG('') - - call psb_get_erraction(err_act) - - allocate(psb_s_rsb_sparse_mat :: b, stat=info) - - if (info /= psb_success_) then - info = psb_err_alloc_dealloc_ - call psb_errpush(info, name) - goto 9999 - end if - return -9999 continue - if (err_act /= psb_act_ret_) then - PSBRSB_ERROR("!") - call psb_error() - end if - return -end subroutine psb_s_rsb_mold - -subroutine psb_s_rsb_reinit(a,clear) - implicit none - class(psb_s_rsb_sparse_mat), intent(inout) :: a - logical, intent(in), optional :: clear - Integer :: info - PSBRSB_DEBUG('') - info=d_rsb_to_psb_info(rsb_reinit_matrix(a%rsbmptr)) -end subroutine psb_s_rsb_reinit - - - function d_rsb_get_nz_row(idx,a) result(res) - implicit none - class(psb_s_rsb_sparse_mat), intent(in) :: a - integer, intent(in) :: idx - integer :: res - integer :: info - PSBRSB_DEBUG('') - res=0 - res=rsb_get_rows_nnz(a%rsbmptr,idx,idx,c_for_flags,info) - info=d_rsb_to_psb_info(info) - if(info.ne.0)res=0 - end function d_rsb_get_nz_row - -subroutine psb_s_cp_rsb_to_coo(a,b,info) - implicit none - class(psb_s_rsb_sparse_mat), intent(in) :: a - class(psb_s_coo_sparse_mat), intent(inout) :: b - integer, intent(out) :: info - - integer, allocatable :: itemp(:) - !locals - logical :: rwshr_ - Integer :: nza, nr, nc,i,j,irw, idl,err_act - integer :: debug_level, debug_unit - character(len=20) :: name - ! PSBRSB_DEBUG('') - info = psb_success_ - nr = a%get_nrows() - nc = a%get_ncols() - nza = a%get_nzeros() - call b%allocate(nr,nc,nza) - call b%psb_s_base_sparse_mat%cp_from(a%psb_s_base_sparse_mat) - info=d_rsb_to_psb_info(rsb_get_coo(a%rsbmptr,b%val,b%ia,b%ja,c_for_flags)) - call b%set_nzeros(a%get_nzeros()) - call b%set_nrows(a%get_nrows()) - call b%set_ncols(a%get_ncols()) - call b%fix(info) - !write(*,*)b%val - !write(*,*)b%ia - !write(*,*)b%ja - !write(*,*)b%get_nrows() - !write(*,*)b%get_ncols() - !write(*,*)b%get_nzeros() - !write(*,*)a%get_nrows() - !write(*,*)a%get_ncols() - !write(*,*)a%get_nzeros() -end subroutine psb_s_cp_rsb_to_coo - -subroutine psb_s_cp_rsb_to_fmt(a,b,info) - use psb_base_mod - implicit none - - class(psb_s_rsb_sparse_mat), intent(in) :: a - class(psb_s_base_sparse_mat), intent(inout) :: b - integer, intent(out) :: info - - !locals - type(psb_s_coo_sparse_mat) :: tmp - logical :: rwshr_ - Integer :: nza, nr, i,j,irw, idl,err_act, nc - integer :: debug_level, debug_unit - character(len=20) :: name - PSBRSB_DEBUG('') - - info = psb_success_ - - select type (b) - type is (psb_s_coo_sparse_mat) - call a%cp_to_coo(b,info) - - type is (psb_s_rsb_sparse_mat) - call b%psb_s_base_sparse_mat%cp_from(a%psb_s_base_sparse_mat)! FIXME: ? - b%rsbmptr=rsb_clone(a%rsbmptr) ! FIXME is thi enough ? - ! FIXME: error handling needed here - - class default - call a%cp_to_coo(tmp,info) - if (info == psb_success_) call b%mv_from_coo(tmp,info) - end select -end subroutine psb_s_cp_rsb_to_fmt - -subroutine psb_s_cp_rsb_from_coo(a,b,info) - use psb_base_mod - implicit none - - class(psb_s_rsb_sparse_mat), intent(inout) :: a - class(psb_s_coo_sparse_mat), intent(in) :: b - integer, intent(out) :: info - - integer, allocatable :: itemp(:) - !locals - logical :: rwshr_ - Integer :: nza, nr, i,j,irw, idl,err_act, nc - integer :: debug_level, debug_unit - integer :: flags - character(len=20) :: name - ! PSBRSB_DEBUG('') - - flags=d_rsb_get_flags(b) - - info = psb_success_ - call a%psb_s_base_sparse_mat%cp_from(b%psb_s_base_sparse_mat) - - !write (*,*) b%val - ! FIXME: and if sorted ? the process could be speeded up ! - a%rsbmptr=rsb_allocate_rsb_sparse_matrix_const& - &(b%val,b%ia,b%ja,b%get_nzeros(),c_typecode,b%get_nrows(),b%get_ncols(),1,1,flags,info) - info=d_rsb_to_psb_info(info) - ! FIXME: should destroy tmp ? -end subroutine psb_s_cp_rsb_from_coo - -subroutine psb_s_cp_rsb_from_fmt(a,b,info) - use psb_base_mod - implicit none - - class(psb_s_rsb_sparse_mat), intent(inout) :: a - class(psb_s_base_sparse_mat), intent(in) :: b - integer, intent(out) :: info - - !locals - type(psb_s_coo_sparse_mat) :: tmp - logical :: rwshr_ - Integer :: nz, nr, i,j,irw, idl,err_act, nc - integer :: debug_level, debug_unit - integer :: flags - character(len=20) :: name - PSBRSB_DEBUG('') - - info = psb_success_ - flags=d_rsb_get_flags(b) - - select type (b) - type is (psb_s_coo_sparse_mat) - call a%cp_from_coo(b,info) - - type is (psb_s_csr_sparse_mat) - call a%psb_s_base_sparse_mat%cp_from(b%psb_s_base_sparse_mat) - a%rsbmptr=rsb_allocate_rsb_sparse_matrix_from_csr_const& - &(b%val,b%irp,b%ja,b%get_nzeros(),c_typecode,b%get_nrows(),b%get_ncols(),1,1,flags,info) - info=d_rsb_to_psb_info(info) - - type is (psb_s_rsb_sparse_mat) - call b%cp_to_fmt(a,info) ! FIXME - ! FIXME: missing error handling - - class default - call b%cp_to_coo(tmp,info) - if (info == psb_success_) call a%mv_from_coo(tmp,info) - end select -end subroutine psb_s_cp_rsb_from_fmt - - -subroutine psb_s_rsb_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) - use psb_base_mod - implicit none - - class(psb_s_rsb_sparse_mat), intent(in) :: a - integer, intent(in) :: imin,imax - integer, intent(out) :: nz - integer, allocatable, intent(inout) :: ia(:), ja(:) - real(psb_spk_), 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, nzrsb - character(len=20) :: name='csget' - logical, parameter :: debug=.false. - ! FIXME: MISSING THE HANDLING OF OPTIONS, HERE - PSBRSB_DEBUG('') - - call psb_erractionsave(err_act) - info = psb_success_ - - if (present(jmin)) then - jmin_ = jmin - else - jmin_ = 1 - endif - if (present(jmax)) then - jmax_ = jmax - else - jmax_ = a%get_ncols() - endif - - if ((imax d_rsb_get_size - procedure, pass(a) :: get_nzeros => d_rsb_get_nzeros - procedure, pass(a) :: get_ncols => d_rsb_get_ncols - procedure, pass(a) :: get_nrows => d_rsb_get_nrows - procedure, nopass :: get_fmt => d_rsb_get_fmt - procedure, pass(a) :: sizeof => d_rsb_sizeof - procedure, pass(a) :: d_csmm => psb_z_rsb_csmm - !procedure, pass(a) :: d_csmv_nt => psb_z_rsb_csmv_nt ! FIXME: a placeholder for future memory - procedure, pass(a) :: d_csmv => psb_z_rsb_csmv - procedure, pass(a) :: d_inner_cssm => psb_z_rsb_cssm - procedure, pass(a) :: d_inner_cssv => psb_z_rsb_cssv - procedure, pass(a) :: d_scals => psb_z_rsb_scals - procedure, pass(a) :: d_scal => psb_z_rsb_scal - procedure, pass(a) :: csnmi => psb_z_rsb_csnmi - procedure, pass(a) :: csnm1 => psb_z_rsb_csnm1 - procedure, pass(a) :: rowsum => psb_z_rsb_rowsum - procedure, pass(a) :: arwsum => psb_z_rsb_arwsum - procedure, pass(a) :: colsum => psb_z_rsb_colsum - procedure, pass(a) :: aclsum => psb_z_rsb_aclsum -! procedure, pass(a) :: reallocate_nz => psb_z_rsb_reallocate_nz ! FIXME -! procedure, pass(a) :: allocate_mnnz => psb_z_rsb_allocate_mnnz ! FIXME - procedure, pass(a) :: cp_to_coo => psb_z_cp_rsb_to_coo - procedure, pass(a) :: cp_from_coo => psb_z_cp_rsb_from_coo - procedure, pass(a) :: cp_to_fmt => psb_z_cp_rsb_to_fmt - procedure, pass(a) :: cp_from_fmt => psb_z_cp_rsb_from_fmt - procedure, pass(a) :: mv_to_coo => psb_z_mv_rsb_to_coo - procedure, pass(a) :: mv_from_coo => psb_z_mv_rsb_from_coo - procedure, pass(a) :: mv_to_fmt => psb_z_mv_rsb_to_fmt - procedure, pass(a) :: mv_from_fmt => psb_z_mv_rsb_from_fmt - procedure, pass(a) :: csput => psb_z_rsb_csput - procedure, pass(a) :: get_diag => psb_z_rsb_get_diag - procedure, pass(a) :: csgetptn => psb_z_rsb_csgetptn - procedure, pass(a) :: d_csgetrow => psb_z_rsb_csgetrow - procedure, pass(a) :: get_nz_row => d_rsb_get_nz_row - procedure, pass(a) :: reinit => psb_z_rsb_reinit - procedure, pass(a) :: trim => psb_z_rsb_trim ! evil - procedure, pass(a) :: print => psb_z_rsb_print - procedure, pass(a) :: free => d_rsb_free - procedure, pass(a) :: mold => psb_z_rsb_mold - procedure, pass(a) :: psb_z_rsb_cp_from - generic, public :: cp_from => psb_z_rsb_cp_from - procedure, pass(a) :: psb_z_rsb_mv_from - generic, public :: mv_from => psb_z_rsb_mv_from - -#endif - end type psb_z_rsb_sparse_mat - ! FIXME: complete the following - !private :: d_rsb_get_nzeros, d_rsb_get_fmt - private :: d_rsb_to_psb_info -#ifdef HAVE_LIBRSB - contains - - function psb_rsb_matmod_init() result(res) - implicit none - integer :: res - !PSBRSB_DEBUG('') - res=-1 ! FIXME -#ifdef HAVE_LIBRSB - res=d_rsb_to_psb_info(rsb_init(c_null_ptr)) -#endif - end function psb_rsb_matmod_init - - function psb_rsb_matmod_exit() result(res) - implicit none - integer :: res - !PSBRSB_DEBUG('') - res=-1 ! FIXME -#ifdef HAVE_LIBRSB - res=d_rsb_to_psb_info(rsb_exit()) -#endif - end function psb_rsb_matmod_exit - - function d_rsb_to_psb_info(info) result(res) - implicit none - integer , intent(in) :: info - integer :: res - !PSBRSB_DEBUG('') - if(info.ne.0)then - res=-1 - else - res=psb_success_ - end if - end function d_rsb_to_psb_info - - function d_rsb_get_flags(a) result(flags) - implicit none - integer :: flags - class(psb_z_base_sparse_mat), intent(in) :: a - !PSBRSB_DEBUG('') - flags=c_def_flags - if(a%is_sorted()) flags=flags+c_srt_flags - if(a%is_triangle()) flags=flags+c_tri_flags - if(a%is_upper()) flags=flags+c_upp_flags - if(a%is_unit()) flags=flags+c_idi_flags - if(a%is_lower()) flags=flags+c_low_flags - end function d_rsb_get_flags - - function d_rsb_get_nzeros(a) result(res) - implicit none - class(psb_z_rsb_sparse_mat), intent(in) :: a - integer :: res - !PSBRSB_DEBUG('') - res=rsb_get_matrix_nnz(a%rsbmptr) - end function d_rsb_get_nzeros - - function d_rsb_get_nrows(a) result(res) - implicit none - class(psb_z_rsb_sparse_mat), intent(in) :: a - integer :: res - !PSBRSB_DEBUG('') - res=rsb_get_matrix_n_rows(a%rsbmptr) - end function d_rsb_get_nrows - - function d_rsb_get_ncols(a) result(res) - implicit none - class(psb_z_rsb_sparse_mat), intent(in) :: a - integer :: res - !PSBRSB_DEBUG('') - res=rsb_get_matrix_n_columns(a%rsbmptr) - end function d_rsb_get_ncols - - function d_rsb_get_fmt() result(res) - implicit none - character(len=5) :: res - !the following printout is harmful, here, if happening during a write :) (causes a deadlock) - !PSBRSB_DEBUG('') - res = 'RSB' - end function d_rsb_get_fmt - - function d_rsb_get_size(a) result(res) - implicit none - class(psb_z_rsb_sparse_mat), intent(in) :: a - integer :: res - !PSBRSB_DEBUG('') - res = d_rsb_get_nzeros(a) - end function d_rsb_get_size - - function d_rsb_sizeof(a) result(res) - implicit none - class(psb_z_rsb_sparse_mat), intent(in) :: a - integer(psb_long_int_k_) :: res - !PSBRSB_DEBUG('') - res=rsb_sizeof(a%rsbmptr) - end function d_rsb_sizeof - -subroutine psb_z_rsb_csmv(alpha,a,x,beta,y,info,trans) - implicit none - class(psb_z_rsb_sparse_mat), intent(in) :: a - complex(psb_dpk_), intent(in) :: alpha, beta, x(:) - complex(psb_dpk_), intent(inout) :: y(:) - integer, intent(out) :: info - character, optional, intent(in) :: trans - character :: trans_ -! PSBRSB_DEBUG('') - info = psb_success_ - - if (present(trans)) then - trans_ = trans - else - trans_ = 'N' - end if - info=d_rsb_to_psb_info(rsb_spmv(rsb_psblas_trans_to_rsb_trans(trans_),alpha,a%rsbmptr,x,1,beta,y,1)) -end subroutine psb_z_rsb_csmv - -subroutine psb_z_rsb_csmv_nt(alpha,a,x1,x2,beta,y1,y2,info) - ! FIXME: this routine is here as a placeholder for a specialized implementation of - ! joint spmv and spmv transposed. - implicit none - class(psb_z_rsb_sparse_mat), intent(in) :: a - complex(psb_dpk_), intent(in) :: alpha, beta, x1(:), x2(:) - complex(psb_dpk_), intent(inout) :: y1(:), y2(:) - integer, intent(out) :: info -! PSBRSB_DEBUG('') - info = psb_success_ - info=d_rsb_to_psb_info(rsb_spmv_nt(alpha,a%rsbmptr,x1,x2,1,beta,y1,y2,1)) - return -end subroutine psb_z_rsb_csmv_nt - -subroutine psb_z_rsb_cssv(alpha,a,x,beta,y,info,trans) - use psb_error_mod - ! FIXME: and what when x is an alias of y ? - ! FIXME: ignoring beta - implicit none - class(psb_z_rsb_sparse_mat), intent(in) :: a - complex(psb_dpk_), intent(in) :: alpha, beta, x(:) - complex(psb_dpk_), intent(inout) :: y(:) - integer, intent(out) :: info - character, optional, intent(in) :: trans - character :: trans_ - Integer :: err_act, i - character(len=20) :: name='rsb_cssv' - logical, parameter :: debug=.false. - - info = psb_success_ - call psb_erractionsave(err_act) - -! PSBRSB_DEBUG('') - - if (present(trans)) then - trans_ = trans - else - trans_ = 'N' - end if - info=d_rsb_to_psb_info(rsb_spsv(rsb_psblas_trans_to_rsb_trans(trans_),alpha,a%rsbmptr,x,1,y,1)) - if (info /= 0) then - i = info - info = psb_err_from_subroutine_ai_ - call psb_errpush(info,name,& - & i_err=(/i,0,0,0,0/),a_err="rsb_spsv") - goto 9999 - end if - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - - if (err_act == psb_act_abort_) then - PSBRSB_ERROR("!") - call psb_error() - return - end if - return - -end subroutine psb_z_rsb_cssv - -subroutine psb_z_rsb_scals(d,a,info) - use psb_base_mod - implicit none - class(psb_z_rsb_sparse_mat), intent(inout) :: a - complex(psb_dpk_), intent(in) :: d - integer, intent(out) :: info - PSBRSB_DEBUG('') - info=d_rsb_to_psb_info(rsb_elemental_scale(a%rsbmptr,d)) -end subroutine psb_z_rsb_scals - -subroutine psb_z_rsb_scal(d,a,info) - use psb_base_mod - implicit none - class(psb_z_rsb_sparse_mat), intent(inout) :: a - complex(psb_dpk_), intent(in) :: d(:) - integer, intent(out) :: info - PSBRSB_DEBUG('') - info=d_rsb_to_psb_info(rsb_scale_rows(a%rsbmptr,d)) -end subroutine psb_z_rsb_scal - - subroutine d_rsb_free(a) - implicit none - class(psb_z_rsb_sparse_mat), intent(inout) :: a - type(c_ptr) :: dummy - !PSBRSB_DEBUG('freeing RSB matrix') - dummy=rsb_free_sparse_matrix(a%rsbmptr) - end subroutine d_rsb_free - -subroutine psb_z_rsb_trim(a) - implicit none - class(psb_z_rsb_sparse_mat), intent(inout) :: a - !PSBRSB_DEBUG('') - ! FIXME: this is supposed to remain empty for RSB -end subroutine psb_z_rsb_trim - - subroutine psb_z_rsb_print(iout,a,iv,eirs,eics,head,ivr,ivc) - integer, intent(in) :: iout - class(psb_z_rsb_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 :: info - PSBRSB_DEBUG('') - ! FIXME: UNFINISHED - info=rsb_print_matrix_t(a%rsbmptr) - end subroutine psb_z_rsb_print - - subroutine psb_z_rsb_get_diag(a,d,info) - class(psb_z_rsb_sparse_mat), intent(in) :: a - complex(psb_dpk_), intent(out) :: d(:) - integer, intent(out) :: info - !PSBRSB_DEBUG('') - info=rsb_getdiag(a%rsbmptr,d) - end subroutine psb_z_rsb_get_diag - -function psb_z_rsb_csnmi(a) result(csnmi_res) - implicit none - class(psb_z_rsb_sparse_mat), intent(in) :: a - real(psb_dpk_),target :: csnmi_res ! please DO NOT rename this variable (see the Makefile) - complex(psb_dpk_) :: resa(1) - integer :: info - !PSBRSB_DEBUG('') - info=rsb_infinity_norm(a%rsbmptr,resa,rsb_psblas_trans_to_rsb_trans('N')) - !info=rsb_infinity_norm(a%rsbmptr,c_loc(res),rsb_psblas_trans_to_rsb_trans('N')) - csnmi_res=resa(1) -end function psb_z_rsb_csnmi - -function psb_z_rsb_csnm1(a) result(res) - implicit none - class(psb_z_rsb_sparse_mat), intent(in) :: a - complex(psb_dpk_) :: res - complex(psb_dpk_) :: resa(1) - integer :: info - PSBRSB_DEBUG('') - info=rsb_one_norm(a%rsbmptr,resa,rsb_psblas_trans_to_rsb_trans('N')) - !info=rsb_one_norm(a%rsbmptr,res,rsb_psblas_trans_to_rsb_trans('N')) -end function psb_z_rsb_csnm1 - -subroutine psb_z_rsb_aclsum(d,a) - use psb_base_mod - class(psb_z_rsb_sparse_mat), intent(in) :: a - complex(psb_dpk_), intent(out) :: d(:) - PSBRSB_DEBUG('') - info=rsb_absolute_columns_sums(a%rsbmptr,d) -end subroutine psb_z_rsb_aclsum - -subroutine psb_z_rsb_arwsum(d,a) - use psb_base_mod - class(psb_z_rsb_sparse_mat), intent(in) :: a - complex(psb_dpk_), intent(out) :: d(:) - PSBRSB_DEBUG('') - info=rsb_absolute_rows_sums(a%rsbmptr,d) -end subroutine psb_z_rsb_arwsum - -subroutine psb_z_rsb_csmm(alpha,a,x,beta,y,info,trans) - use psb_base_mod - implicit none - class(psb_z_rsb_sparse_mat), intent(in) :: a - complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:) - complex(psb_dpk_), intent(inout) :: y(:,:) - integer, intent(out) :: info - character, optional, intent(in) :: trans - - character :: trans_ - integer :: ldy,ldx,nc - PSBRSB_DEBUG('') - PSBRSB_DEBUG('ERROR: UNIMPLEMENTED') - - if (present(trans)) then - trans_ = trans - else - trans_ = 'N' - end if - ldx=size(x,1); ldy=size(y,1) - nc=min(size(x,2),size(y,2) ) - info=-1 - info=d_rsb_to_psb_info(rsb_spmm(rsb_psblas_trans_to_rsb_trans(trans_),alpha,a%rsbmptr,nc,c_f_order,x,ldx,beta,y,ldy)) -end subroutine psb_z_rsb_csmm - -subroutine psb_z_rsb_cssm(alpha,a,x,beta,y,info,trans) - use psb_base_mod - implicit none - class(psb_z_rsb_sparse_mat), intent(in) :: a - complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:) - complex(psb_dpk_), intent(inout) :: y(:,:) - integer, intent(out) :: info - character, optional, intent(in) :: trans - integer :: ldy,ldx,nc - character :: trans_ - PSBRSB_DEBUG('') - PSBRSB_DEBUG('ERROR: UNIMPLEMENTED') - if (present(trans)) then - trans_ = trans - else - trans_ = 'N' - end if - ldx=size(x,1); ldy=size(y,1) - nc=min(size(x,2),size(y,2) ) - info=-1 - info=d_rsb_to_psb_info(rsb_spsm(rsb_psblas_trans_to_rsb_trans(trans_),alpha,a%rsbmptr,nc,c_f_order,beta,x,ldx,y,ldy)) -end subroutine - -subroutine psb_z_rsb_rowsum(d,a) - use psb_base_mod - class(psb_z_rsb_sparse_mat), intent(in) :: a - complex(psb_dpk_), intent(out) :: d(:) - integer :: info - PSBRSB_DEBUG('') - info=d_rsb_to_psb_info(rsb_rows_sums(a%rsbmptr,d)) -end subroutine psb_z_rsb_rowsum - -subroutine psb_z_rsb_colsum(d,a) - use psb_base_mod - class(psb_z_rsb_sparse_mat), intent(in) :: a - complex(psb_dpk_), intent(out) :: d(:) - integer :: info - PSBRSB_DEBUG('') - info=d_rsb_to_psb_info(rsb_columns_sums(a%rsbmptr,d)) -end subroutine psb_z_rsb_colsum - -subroutine psb_z_rsb_mold(a,b,info) - use psb_base_mod - implicit none - class(psb_z_rsb_sparse_mat), intent(in) :: a - class(psb_z_base_sparse_mat), intent(out), allocatable :: b - integer, intent(out) :: info - Integer :: err_act - character(len=20) :: name='reallocate_nz' - logical, parameter :: debug=.false. - PSBRSB_DEBUG('') - - call psb_get_erraction(err_act) - - allocate(psb_z_rsb_sparse_mat :: b, stat=info) - - if (info /= psb_success_) then - info = psb_err_alloc_dealloc_ - call psb_errpush(info, name) - goto 9999 - end if - return -9999 continue - if (err_act /= psb_act_ret_) then - PSBRSB_ERROR("!") - call psb_error() - end if - return -end subroutine psb_z_rsb_mold - -subroutine psb_z_rsb_reinit(a,clear) - implicit none - class(psb_z_rsb_sparse_mat), intent(inout) :: a - logical, intent(in), optional :: clear - Integer :: info - PSBRSB_DEBUG('') - info=d_rsb_to_psb_info(rsb_reinit_matrix(a%rsbmptr)) -end subroutine psb_z_rsb_reinit - - - function d_rsb_get_nz_row(idx,a) result(res) - implicit none - class(psb_z_rsb_sparse_mat), intent(in) :: a - integer, intent(in) :: idx - integer :: res - integer :: info - PSBRSB_DEBUG('') - res=0 - res=rsb_get_rows_nnz(a%rsbmptr,idx,idx,c_for_flags,info) - info=d_rsb_to_psb_info(info) - if(info.ne.0)res=0 - end function d_rsb_get_nz_row - -subroutine psb_z_cp_rsb_to_coo(a,b,info) - implicit none - class(psb_z_rsb_sparse_mat), intent(in) :: a - class(psb_z_coo_sparse_mat), intent(inout) :: b - integer, intent(out) :: info - - integer, allocatable :: itemp(:) - !locals - logical :: rwshr_ - Integer :: nza, nr, nc,i,j,irw, idl,err_act - integer :: debug_level, debug_unit - character(len=20) :: name - ! PSBRSB_DEBUG('') - info = psb_success_ - nr = a%get_nrows() - nc = a%get_ncols() - nza = a%get_nzeros() - call b%allocate(nr,nc,nza) - call b%psb_z_base_sparse_mat%cp_from(a%psb_z_base_sparse_mat) - info=d_rsb_to_psb_info(rsb_get_coo(a%rsbmptr,b%val,b%ia,b%ja,c_for_flags)) - call b%set_nzeros(a%get_nzeros()) - call b%set_nrows(a%get_nrows()) - call b%set_ncols(a%get_ncols()) - call b%fix(info) - !write(*,*)b%val - !write(*,*)b%ia - !write(*,*)b%ja - !write(*,*)b%get_nrows() - !write(*,*)b%get_ncols() - !write(*,*)b%get_nzeros() - !write(*,*)a%get_nrows() - !write(*,*)a%get_ncols() - !write(*,*)a%get_nzeros() -end subroutine psb_z_cp_rsb_to_coo - -subroutine psb_z_cp_rsb_to_fmt(a,b,info) - use psb_base_mod - implicit none - - class(psb_z_rsb_sparse_mat), intent(in) :: a - class(psb_z_base_sparse_mat), intent(inout) :: b - integer, intent(out) :: info - - !locals - type(psb_z_coo_sparse_mat) :: tmp - logical :: rwshr_ - Integer :: nza, nr, i,j,irw, idl,err_act, nc - integer :: debug_level, debug_unit - character(len=20) :: name - PSBRSB_DEBUG('') - - info = psb_success_ - - select type (b) - type is (psb_z_coo_sparse_mat) - call a%cp_to_coo(b,info) - - type is (psb_z_rsb_sparse_mat) - call b%psb_z_base_sparse_mat%cp_from(a%psb_z_base_sparse_mat)! FIXME: ? - b%rsbmptr=rsb_clone(a%rsbmptr) ! FIXME is thi enough ? - ! FIXME: error handling needed here - - class default - call a%cp_to_coo(tmp,info) - if (info == psb_success_) call b%mv_from_coo(tmp,info) - end select -end subroutine psb_z_cp_rsb_to_fmt - -subroutine psb_z_cp_rsb_from_coo(a,b,info) - use psb_base_mod - implicit none - - class(psb_z_rsb_sparse_mat), intent(inout) :: a - class(psb_z_coo_sparse_mat), intent(in) :: b - integer, intent(out) :: info - - integer, allocatable :: itemp(:) - !locals - logical :: rwshr_ - Integer :: nza, nr, i,j,irw, idl,err_act, nc - integer :: debug_level, debug_unit - integer :: flags - character(len=20) :: name - ! PSBRSB_DEBUG('') - - flags=d_rsb_get_flags(b) - - info = psb_success_ - call a%psb_z_base_sparse_mat%cp_from(b%psb_z_base_sparse_mat) - - !write (*,*) b%val - ! FIXME: and if sorted ? the process could be speeded up ! - a%rsbmptr=rsb_allocate_rsb_sparse_matrix_const& - &(b%val,b%ia,b%ja,b%get_nzeros(),c_typecode,b%get_nrows(),b%get_ncols(),1,1,flags,info) - info=d_rsb_to_psb_info(info) - ! FIXME: should destroy tmp ? -end subroutine psb_z_cp_rsb_from_coo - -subroutine psb_z_cp_rsb_from_fmt(a,b,info) - use psb_base_mod - implicit none - - class(psb_z_rsb_sparse_mat), intent(inout) :: a - class(psb_z_base_sparse_mat), intent(in) :: b - integer, intent(out) :: info - - !locals - type(psb_z_coo_sparse_mat) :: tmp - logical :: rwshr_ - Integer :: nz, nr, i,j,irw, idl,err_act, nc - integer :: debug_level, debug_unit - integer :: flags - character(len=20) :: name - PSBRSB_DEBUG('') - - info = psb_success_ - flags=d_rsb_get_flags(b) - - select type (b) - type is (psb_z_coo_sparse_mat) - call a%cp_from_coo(b,info) - - type is (psb_z_csr_sparse_mat) - call a%psb_z_base_sparse_mat%cp_from(b%psb_z_base_sparse_mat) - a%rsbmptr=rsb_allocate_rsb_sparse_matrix_from_csr_const& - &(b%val,b%irp,b%ja,b%get_nzeros(),c_typecode,b%get_nrows(),b%get_ncols(),1,1,flags,info) - info=d_rsb_to_psb_info(info) - - type is (psb_z_rsb_sparse_mat) - call b%cp_to_fmt(a,info) ! FIXME - ! FIXME: missing error handling - - class default - call b%cp_to_coo(tmp,info) - if (info == psb_success_) call a%mv_from_coo(tmp,info) - end select -end subroutine psb_z_cp_rsb_from_fmt - - -subroutine psb_z_rsb_csgetrow(imin,imax,a,nz,ia,ja,val,info,& - & jmin,jmax,iren,append,nzin,rscale,cscale) - use psb_base_mod - implicit none - - class(psb_z_rsb_sparse_mat), intent(in) :: a - integer, intent(in) :: imin,imax - integer, intent(out) :: nz - integer, allocatable, intent(inout) :: ia(:), ja(:) - complex(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, nzrsb - character(len=20) :: name='csget' - logical, parameter :: debug=.false. - ! FIXME: MISSING THE HANDLING OF OPTIONS, HERE - PSBRSB_DEBUG('') - - call psb_erractionsave(err_act) - info = psb_success_ - - if (present(jmin)) then - jmin_ = jmin - else - jmin_ = 1 - endif - if (present(jmax)) then - jmax_ = jmax - else - jmax_ = a%get_ncols() - endif - - if ((imax psb_c_base_apply + procedure, pass(prec) :: set_ctxt => psb_c_base_set_ctxt + procedure, pass(prec) :: get_ctxt => psb_c_base_get_ctxt + procedure, pass(prec) :: c_apply_v => psb_c_base_apply_vect + procedure, pass(prec) :: c_apply => psb_c_base_apply + generic, public :: apply => c_apply, c_apply_v procedure, pass(prec) :: precbld => psb_c_base_precbld procedure, pass(prec) :: precseti => psb_c_base_precseti procedure, pass(prec) :: precsetr => psb_c_base_precsetr @@ -55,15 +60,53 @@ module psb_c_base_prec_mod procedure, pass(prec) :: precinit => psb_c_base_precinit procedure, pass(prec) :: precfree => psb_c_base_precfree procedure, pass(prec) :: precdescr => psb_c_base_precdescr + procedure, pass(prec) :: dump => psb_c_base_precdump end type psb_c_base_prec_type private :: psb_c_base_apply, psb_c_base_precbld, psb_c_base_precseti,& & psb_c_base_precsetr, psb_c_base_precsetc, psb_c_base_sizeof,& - & psb_c_base_precinit, psb_c_base_precfree, psb_c_base_precdescr + & psb_c_base_precinit, psb_c_base_precfree, psb_c_base_precdescr,& + & psb_c_base_precdump, psb_c_base_set_ctxt, psb_c_base_get_ctxt, & + & psb_c_base_apply_vect - contains + subroutine psb_c_base_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) + use psb_base_mod + type(psb_desc_type),intent(in) :: desc_data + class(psb_c_base_prec_type), intent(inout) :: prec + complex(psb_spk_),intent(in) :: alpha, beta + type(psb_c_vect_type),intent(inout) :: x + type(psb_c_vect_type),intent(inout) :: y + integer, intent(out) :: info + character(len=1), optional :: trans + complex(psb_spk_),intent(inout), optional, target :: work(:) + Integer :: err_act, nrow + character(len=20) :: name='d_base_prec_apply' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + 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 psb_c_base_apply_vect + subroutine psb_c_base_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) use psb_base_mod type(psb_desc_type),intent(in) :: desc_data @@ -132,18 +175,19 @@ contains return end subroutine psb_c_base_precinit - subroutine psb_c_base_precbld(a,desc_a,prec,info,upd,mold,afmt) + subroutine psb_c_base_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold) use psb_base_mod Implicit None type(psb_cspmat_type), intent(in), target :: a - type(psb_desc_type), intent(in), target :: desc_a + type(psb_desc_type), intent(in), target :: desc_a class(psb_c_base_prec_type),intent(inout) :: prec - integer, intent(out) :: info - character, intent(in), optional :: upd + integer, intent(out) :: info + character, intent(in), optional :: upd character(len=*), intent(in), optional :: afmt - class(psb_c_base_sparse_mat), intent(in), optional :: mold + class(psb_c_base_sparse_mat), intent(in), optional :: amold + class(psb_c_base_vect_type), intent(in), optional :: vmold Integer :: err_act, nrow character(len=20) :: name='c_base_precbld' @@ -340,6 +384,47 @@ contains end subroutine psb_c_base_precdescr + subroutine psb_c_base_precdump(prec,info,prefix,head) + use psb_base_mod + implicit none + class(psb_c_base_prec_type), intent(in) :: prec + integer, intent(out) :: info + character(len=*), intent(in), optional :: prefix,head + Integer :: err_act, nrow + character(len=20) :: name='d_base_precdump' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + 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 psb_c_base_precdump + + subroutine psb_c_base_set_ctxt(prec,ictxt) + use psb_base_mod + implicit none + class(psb_c_base_prec_type), intent(inout) :: prec + integer, intent(in) :: ictxt + + prec%ictxt = ictxt + + end subroutine psb_c_base_set_ctxt function psb_c_base_sizeof(prec) result(val) use psb_base_mod @@ -350,4 +435,13 @@ contains return end function psb_c_base_sizeof + function psb_c_base_get_ctxt(prec) result(val) + use psb_base_mod + class(psb_c_base_prec_type), intent(in) :: prec + integer :: val + + val = prec%ictxt + return + end function psb_c_base_get_ctxt + end module psb_c_base_prec_mod diff --git a/prec/psb_c_bjacprec.f90 b/prec/psb_c_bjacprec.f90 index d726e85c7..7f19fab90 100644 --- a/prec/psb_c_bjacprec.f90 +++ b/prec/psb_c_bjacprec.f90 @@ -2,12 +2,14 @@ module psb_c_bjacprec use psb_c_base_prec_mod - type, extends(psb_c_base_prec_type) :: psb_c_bjac_prec_type + type, extends(psb_c_base_prec_type) :: psb_c_bjac_prec_type integer, allocatable :: iprcparm(:) - type(psb_cspmat_type), allocatable :: av(:) - complex(psb_spk_), allocatable :: d(:) + type(psb_cspmat_type), allocatable :: av(:) + complex(psb_spk_), allocatable :: d(:) + type(psb_c_vect_type), allocatable :: dv contains - procedure, pass(prec) :: apply => psb_c_bjac_apply + procedure, pass(prec) :: c_apply_v => psb_c_bjac_apply_vect + procedure, pass(prec) :: c_apply => psb_c_bjac_apply procedure, pass(prec) :: precbld => psb_c_bjac_precbld procedure, pass(prec) :: precinit => psb_c_bjac_precinit procedure, pass(prec) :: precseti => psb_c_bjac_precseti @@ -15,13 +17,15 @@ module psb_c_bjacprec procedure, pass(prec) :: precsetc => psb_c_bjac_precsetc procedure, pass(prec) :: precfree => psb_c_bjac_precfree procedure, pass(prec) :: precdescr => psb_c_bjac_precdescr + procedure, pass(prec) :: dump => psb_c_bjac_dump procedure, pass(prec) :: sizeof => psb_c_bjac_sizeof end type psb_c_bjac_prec_type private :: psb_c_bjac_apply, psb_c_bjac_precbld, psb_c_bjac_precseti,& & psb_c_bjac_precsetr, psb_c_bjac_precsetc, psb_c_bjac_sizeof,& - & psb_c_bjac_precinit, psb_c_bjac_precfree, psb_c_bjac_precdescr - + & psb_c_bjac_precinit, psb_c_bjac_precfree, psb_c_bjac_precdescr,& + & psb_c_bjac_dump, psb_c_bjac_apply_vect + character(len=15), parameter, private :: & & fact_names(0:2)=(/'None ','ILU(n) ',& @@ -29,6 +33,154 @@ module psb_c_bjacprec contains + subroutine psb_c_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) + use psb_base_mod + type(psb_desc_type),intent(in) :: desc_data + class(psb_c_bjac_prec_type), intent(inout) :: prec + complex(psb_spk_),intent(in) :: alpha,beta + type(psb_c_vect_type),intent(inout) :: x + type(psb_c_vect_type),intent(inout) :: y + integer, intent(out) :: info + character(len=1), optional :: trans + complex(psb_spk_),intent(inout), optional, target :: work(:) + + ! Local variables + integer :: n_row,n_col + complex(psb_spk_), pointer :: ww(:), aux(:) + type(psb_c_vect_type) :: wv + integer :: ictxt,np,me, err_act, int_err(5) + integer :: debug_level, debug_unit + character :: trans_ + character(len=20) :: name='d_bjac_prec_apply' + character(len=20) :: ch_err + + info = psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + ictxt = desc_data%get_context() + call psb_info(ictxt, me, np) + + + trans_ = psb_toupper(trans) + select case(trans_) + case('N','T','C') + ! Ok + case default + call psb_errpush(psb_err_iarg_invalid_i_,name) + goto 9999 + end select + + + n_row = desc_data%get_local_rows() + n_col = desc_data%get_local_cols() + + if (x%get_nrows() < n_row) then + info = 36 + call psb_errpush(info,name,i_err=(/2,n_row,0,0,0/)) + goto 9999 + end if + if (y%get_nrows() < n_row) then + info = 36 + call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/)) + goto 9999 + end if + if (.not.allocated(prec%d)) then + info = 1124 + call psb_errpush(info,name,a_err="preconditioner: D") + goto 9999 + end if + if (size(prec%d) < n_row) then + info = 1124 + call psb_errpush(info,name,a_err="preconditioner: D") + goto 9999 + end if + + + if (n_col <= size(work)) then + ww => work(1:n_col) + if ((4*n_col+n_col) <= size(work)) then + aux => work(n_col+1:) + else + allocate(aux(4*n_col),stat=info) + + endif + else + allocate(ww(n_col),aux(4*n_col),stat=info) + endif + if (info == psb_success_) allocate(wv%v,mold=x%v) + + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') + goto 9999 + end if + call wv%bld(n_col) + + select case(prec%iprcparm(psb_f_type_)) + case(psb_f_ilu_n_) + + select case(trans_) + case('N') + call psb_spsm(cone,prec%av(psb_l_pr_),x,czero,wv,desc_data,info,& + & trans=trans_,scale='L',diag=prec%dv,choice=psb_none_,work=aux) + if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_u_pr_),wv,& + & beta,y,desc_data,info,& + & trans=trans_,scale='U',choice=psb_none_, work=aux) + + case('T') + call psb_spsm(cone,prec%av(psb_u_pr_),x,czero,wv,desc_data,info,& + & trans=trans_,scale='L',diag=prec%dv,choice=psb_none_, work=aux) + if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_l_pr_),wv,& + & beta,y,desc_data,info,& + & trans=trans_,scale='U',choice=psb_none_,work=aux) + + case('C') + write(0,*) 'WARNING: Conjguate case not fixed yet' + call psb_spsm(cone,prec%av(psb_u_pr_),x,czero,wv,desc_data,info,& + & trans=trans_,scale='L',diag=prec%dv,choice=psb_none_, work=aux) + if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_l_pr_),wv,& + & beta,y,desc_data,info,& + & trans=trans_,scale='U',choice=psb_none_,work=aux) + + end select + if (info /= psb_success_) then + ch_err="psb_spsm" + goto 9999 + end if + + + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='Invalid factorization') + goto 9999 + end select + +!!$ call psb_halo(y,desc_data,info,data=psb_comm_mov_) + + if (n_col <= size(work)) then + if ((4*n_col+n_col) <= size(work)) then + else + deallocate(aux) + endif + else + deallocate(ww,aux) + endif + + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_errpush(info,name,i_err=int_err,a_err=ch_err) + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + + + end subroutine psb_c_bjac_apply_vect subroutine psb_c_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) use psb_base_mod @@ -81,16 +233,16 @@ contains call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/)) goto 9999 end if - if (.not.allocated(prec%d)) then - info = 1124 - call psb_errpush(info,name,a_err="preconditioner: D") - goto 9999 - end if - if (size(prec%d) < n_row) then - info = 1124 - call psb_errpush(info,name,a_err="preconditioner: D") - goto 9999 - end if +!!$ if (.not.allocated(prec%d)) then +!!$ info = 1124 +!!$ call psb_errpush(info,name,a_err="preconditioner: D") +!!$ goto 9999 +!!$ end if +!!$ if (size(prec%d) < n_row) then +!!$ info = 1124 +!!$ call psb_errpush(info,name,a_err="preconditioner: D") +!!$ goto 9999 +!!$ end if if (n_col <= size(work)) then @@ -120,21 +272,24 @@ contains select case(trans_) case('N') call psb_spsm(cone,prec%av(psb_l_pr_),x,czero,ww,desc_data,info,& - & trans=trans_,scale='L',diag=prec%d,choice=psb_none_,work=aux) - if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_u_pr_),ww,beta,y,& - & desc_data,info,trans=trans_,scale='U',choice=psb_none_, work=aux) + & trans=trans_,scale='L',diag=prec%dv%v%v,choice=psb_none_,work=aux) + if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_u_pr_),ww,& + & beta,y,desc_data,info,& + & trans=trans_,scale='U',choice=psb_none_, work=aux) case('T') call psb_spsm(cone,prec%av(psb_u_pr_),x,czero,ww,desc_data,info,& - & trans=trans_,scale='L',diag=prec%d,choice=psb_none_, work=aux) - if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_l_pr_),ww,beta,y,& - & desc_data,info,trans=trans_,scale='U',choice=psb_none_,work=aux) - + & trans=trans_,scale='L',diag=prec%dv%v%v,choice=psb_none_, work=aux) + if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_l_pr_),ww,& + & beta,y,desc_data,info,& + & trans=trans_,scale='U',choice=psb_none_,work=aux) + case('C') call psb_spsm(cone,prec%av(psb_u_pr_),x,czero,ww,desc_data,info,& - & trans=trans_,scale='L',diag=conjg(prec%d),choice=psb_none_, work=aux) - if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_l_pr_),ww,beta,y,& - & desc_data,info,trans=trans_,scale='U',choice=psb_none_,work=aux) + & trans=trans_,scale='L',diag=conjg(prec%dv%v%v),choice=psb_none_, work=aux) + if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_l_pr_),ww,& + & beta,y,desc_data,info,& + & trans=trans_,scale='U',choice=psb_none_,work=aux) end select if (info /= psb_success_) then @@ -215,7 +370,7 @@ contains end subroutine psb_c_bjac_precinit - subroutine psb_c_bjac_precbld(a,desc_a,prec,info,upd,mold,afmt) + subroutine psb_c_bjac_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold) use psb_base_mod use psb_prec_mod, only : psb_ilu_fct @@ -227,13 +382,15 @@ contains integer, intent(out) :: info character, intent(in), optional :: upd character(len=*), intent(in), optional :: afmt - class(psb_c_base_sparse_mat), intent(in), optional :: mold + class(psb_c_base_sparse_mat), intent(in), optional :: amold + class(psb_c_base_vect_type), intent(in), optional :: vmold ! .. Local Scalars .. integer :: i, m integer :: int_err(5) character :: trans, unitd type(psb_c_csr_sparse_mat), allocatable :: lf, uf + complex(psb_spk_), allocatable :: dd(:) integer nztota, err_act, n_row, nrow_a,n_col, nhalo integer :: ictxt,np,me character(len=20) :: name='c_bjac_precbld' @@ -248,6 +405,8 @@ contains ictxt=desc_a%get_context() call psb_info(ictxt, me, np) + call prec%set_ctxt(ictxt) + m = a%get_nrows() if (m < 0) then info = psb_err_iarg_neg_ @@ -297,21 +456,24 @@ contains goto 9999 end if - if (allocated(prec%d)) then - if (size(prec%d) < n_row) then - deallocate(prec%d) - endif - endif - if (.not.allocated(prec%d)) then - allocate(prec%d(n_row),stat=info) - if (info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') - goto 9999 + allocate(dd(n_row),stat=info) + if (info == psb_success_) then + allocate(prec%dv, stat=info) + if (info == 0) then + if (present(vmold)) then + allocate(prec%dv%v,mold=vmold,stat=info) + else + allocate(psb_c_base_vect_type :: prec%dv%v,stat=info) + end if end if - + end if + + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') + goto 9999 endif ! This is where we have no renumbering, thus no need - call psb_ilu_fct(a,lf,uf,prec%d,info) + call psb_ilu_fct(a,lf,uf,dd,info) if(info == psb_success_) then call prec%av(psb_l_pr_)%mv_from(lf) @@ -320,13 +482,15 @@ contains call prec%av(psb_u_pr_)%set_asb() call prec%av(psb_l_pr_)%trim() call prec%av(psb_u_pr_)%trim() + call prec%dv%bld(dd) + call move_alloc(dd,prec%d) else info=psb_err_from_subroutine_ ch_err='psb_ilu_fct' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - + case(psb_f_none_) info=psb_err_from_subroutine_ ch_err='Inconsistent prec psb_f_none_' @@ -340,9 +504,9 @@ contains goto 9999 end select - if (present(mold)) then - call prec%av(psb_l_pr_)%cscnv(info,mold=mold) - call prec%av(psb_u_pr_)%cscnv(info,mold=mold) + if (present(amold)) then + call prec%av(psb_l_pr_)%cscnv(info,mold=amold) + call prec%av(psb_u_pr_)%cscnv(info,mold=amold) else if (present(afmt)) then call prec%av(psb_l_pr_)%cscnv(info,type=afmt) call prec%av(psb_u_pr_)%cscnv(info,type=afmt) @@ -385,15 +549,18 @@ contains select case(what) case (psb_f_type_) if (prec%iprcparm(psb_p_type_) /= psb_bjac_) then - write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',prec%iprcparm(psb_p_type_),& + write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',& + & prec%iprcparm(psb_p_type_),& & 'ignoring user specification' return endif prec%iprcparm(psb_f_type_) = val case (psb_ilu_fill_in_) - if ((prec%iprcparm(psb_p_type_) /= psb_bjac_).or.(prec%iprcparm(psb_f_type_) /= psb_f_ilu_n_)) then - write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',prec%iprcparm(psb_p_type_),& + if ((prec%iprcparm(psb_p_type_) /= psb_bjac_).or.& + & (prec%iprcparm(psb_f_type_) /= psb_f_ilu_n_)) then + write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',& + & prec%iprcparm(psb_p_type_),& & 'ignoring user specification' return endif @@ -495,6 +662,10 @@ contains if (allocated(prec%d)) then deallocate(prec%d,stat=info) end if + if (allocated(prec%dv)) then + call prec%dv%free(info) + if (info == 0) deallocate(prec%dv,stat=info) + end if call psb_erractionrestore(err_act) return @@ -557,6 +728,46 @@ contains end subroutine psb_c_bjac_precdescr + + subroutine psb_c_bjac_dump(prec,info,prefix,head) + use psb_base_mod + implicit none + class(psb_c_bjac_prec_type), intent(in) :: prec + integer, intent(out) :: info + character(len=*), intent(in), optional :: prefix,head + integer :: i, j, il1, iln, lname, lev + integer :: ictxt,iam, np + character(len=80) :: prefix_ + character(len=120) :: fname ! len should be at least 20 more than + + ! len of prefix_ + + info = 0 + ictxt = prec%get_ctxt() + call psb_info(ictxt,iam,np) + + if (present(prefix)) then + prefix_ = trim(prefix(1:min(len(prefix),len(prefix_)))) + else + prefix_ = "dump_fact_d" + end if + + lname = len_trim(prefix_) + fname = trim(prefix_) + write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam + lname = lname + 5 + write(fname(lname+1:),'(a)')'_lower.mtx' + if (prec%av(psb_l_pr_)%is_asb()) & + & call prec%av(psb_l_pr_)%print(fname,head=head) + write(fname(lname+1:),'(a,a)')'_diag.mtx' + if (allocated(prec%d)) & + & call psb_geprt(fname,prec%d,head=head) + write(fname(lname+1:),'(a)')'_upper.mtx' + if (prec%av(psb_u_pr_)%is_asb()) & + & call prec%av(psb_u_pr_)%print(fname,head=head) + + end subroutine psb_c_bjac_dump + function psb_c_bjac_sizeof(prec) result(val) use psb_base_mod class(psb_c_bjac_prec_type), intent(in) :: prec diff --git a/prec/psb_c_diagprec.f90 b/prec/psb_c_diagprec.f90 index 2a22fd6d2..af8e27e1c 100644 --- a/prec/psb_c_diagprec.f90 +++ b/prec/psb_c_diagprec.f90 @@ -3,9 +3,11 @@ module psb_c_diagprec use psb_c_base_prec_mod type, extends(psb_c_base_prec_type) :: psb_c_diag_prec_type - complex(psb_spk_), allocatable :: d(:) + complex(psb_spk_), allocatable :: d(:) + type(psb_c_vect_type), allocatable :: dv contains - procedure, pass(prec) :: apply => psb_c_diag_apply + procedure, pass(prec) :: c_apply_v => psb_c_diag_apply_vect + procedure, pass(prec) :: c_apply => psb_c_diag_apply procedure, pass(prec) :: precbld => psb_c_diag_precbld procedure, pass(prec) :: precinit => psb_c_diag_precinit procedure, pass(prec) :: precseti => psb_c_diag_precseti @@ -18,12 +20,94 @@ module psb_c_diagprec private :: psb_c_diag_apply, psb_c_diag_precbld, psb_c_diag_precseti,& & psb_c_diag_precsetr, psb_c_diag_precsetc, psb_c_diag_sizeof,& - & psb_c_diag_precinit, psb_c_diag_precfree, psb_c_diag_precdescr + & psb_c_diag_precinit, psb_c_diag_precfree, psb_c_diag_precdescr,& + & psb_c_diag_apply_vect contains + subroutine psb_c_diag_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) + use psb_base_mod + type(psb_desc_type),intent(in) :: desc_data + class(psb_c_diag_prec_type), intent(inout) :: prec + type(psb_c_vect_type),intent(inout) :: x + complex(psb_spk_),intent(in) :: alpha, beta + type(psb_c_vect_type),intent(inout) :: y + integer, intent(out) :: info + character(len=1), optional :: trans + complex(psb_spk_),intent(inout), optional, target :: work(:) + Integer :: err_act, nrow + character(len=20) :: name='d_diag_prec_apply' + complex(psb_spk_), pointer :: ww(:) + class(psb_c_base_vect_type), allocatable :: dw + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the DIAG preonditioner??? + ! + info = psb_success_ + + nrow = desc_data%get_local_rows() + if (x%get_nrows() < nrow) then + info = 36 + call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/)) + goto 9999 + end if + if (y%get_nrows() < nrow) then + info = 36 + call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/)) + goto 9999 + end if + if (.not.allocated(prec%d)) then + info = 1124 + call psb_errpush(info,name,a_err="preconditioner: D") + goto 9999 + end if + if (size(prec%d) < nrow) then + info = 1124 + call psb_errpush(info,name,a_err="preconditioner: D") + goto 9999 + end if + + if (size(work) >= x%get_nrows()) then + ww => work + else + allocate(ww(x%get_nrows()),stat=info) + if (info /= psb_success_) then + call psb_errpush(psb_err_alloc_request_,name,& + & i_err=(/x%get_nrows(),0,0,0,0/),a_err='complex(psb_spk_)') + goto 9999 + end if + end if + + + call y%mlt(alpha,prec%dv,x,beta,info,conjgx=trans) + + if (size(work) < x%get_nrows()) then + deallocate(ww,stat=info) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='Deallocate') + goto 9999 + end if + end if + +2 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 psb_c_diag_apply_vect + + subroutine psb_c_diag_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) use psb_base_mod type(psb_desc_type),intent(in) :: desc_data @@ -41,13 +125,8 @@ contains call psb_erractionsave(err_act) - ! - ! This is the base version and we should throw an error. - ! Or should it be the DIAG preonditioner??? - ! info = psb_success_ - nrow = desc_data%get_local_rows() if (size(x) < nrow) then info = 36 @@ -153,7 +232,7 @@ contains end subroutine psb_c_diag_precinit - subroutine psb_c_diag_precbld(a,desc_a,prec,info,upd,mold,afmt) + subroutine psb_c_diag_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold) use psb_base_mod Implicit None @@ -164,7 +243,8 @@ contains integer, intent(out) :: info character, intent(in), optional :: upd character(len=*), intent(in), optional :: afmt - class(psb_c_base_sparse_mat), intent(in), optional :: mold + class(psb_c_base_sparse_mat), intent(in), optional :: amold + class(psb_c_base_vect_type), intent(in), optional :: vmold Integer :: err_act, nrow,i character(len=20) :: name='c_diag_precbld' @@ -200,7 +280,20 @@ contains prec%d(i) = done/prec%d(i) endif end do - + allocate(prec%dv,stat=info) + if (info == 0) then + if (present(vmold)) then + allocate(prec%dv%v,mold=vmold,stat=info) + else + allocate(psb_c_base_vect_type :: prec%dv%v,stat=info) + end if + end if + if (info == 0) then + call prec%dv%bld(prec%d) + else + write(0,*) 'Error on precbld ',info + end if + call psb_erractionrestore(err_act) return @@ -311,6 +404,8 @@ contains call psb_erractionsave(err_act) info = psb_success_ + + if (allocated(prec%dv)) call prec%dv%free(info) call psb_erractionrestore(err_act) return diff --git a/prec/psb_c_nullprec.f90 b/prec/psb_c_nullprec.f90 index 9f47da8cb..bce35858f 100644 --- a/prec/psb_c_nullprec.f90 +++ b/prec/psb_c_nullprec.f90 @@ -4,7 +4,8 @@ module psb_c_nullprec type, extends(psb_c_base_prec_type) :: psb_c_null_prec_type contains - procedure, pass(prec) :: apply => psb_c_null_apply + procedure, pass(prec) :: c_apply_v => psb_c_null_apply_vect + procedure, pass(prec) :: c_apply => psb_c_null_apply procedure, pass(prec) :: precbld => psb_c_null_precbld procedure, pass(prec) :: precinit => psb_c_null_precinit procedure, pass(prec) :: precseti => psb_c_null_precseti @@ -17,20 +18,21 @@ module psb_c_nullprec private :: psb_c_null_apply, psb_c_null_precbld, psb_c_null_precseti,& & psb_c_null_precsetr, psb_c_null_precsetc, psb_c_null_sizeof,& - & psb_c_null_precinit, psb_c_null_precfree, psb_c_null_precdescr + & psb_c_null_precinit, psb_c_null_precfree, psb_c_null_precdescr, & + & psb_c_null_apply_vect contains - subroutine psb_c_null_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) + subroutine psb_c_null_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) use psb_base_mod - type(psb_desc_type),intent(in) :: desc_data - class(psb_c_null_prec_type), intent(in) :: prec - complex(psb_spk_),intent(inout) :: x(:) + type(psb_desc_type),intent(in) :: desc_data + class(psb_c_null_prec_type), intent(inout) :: prec + type(psb_c_vect_type),intent(inout) :: x complex(psb_spk_),intent(in) :: alpha, beta - complex(psb_spk_),intent(inout) :: y(:) - integer, intent(out) :: info - character(len=1), optional :: trans + type(psb_c_vect_type),intent(inout) :: y + integer, intent(out) :: info + character(len=1), optional :: trans complex(psb_spk_),intent(inout), optional, target :: work(:) Integer :: err_act, nrow character(len=20) :: name='c_null_prec_apply' @@ -43,6 +45,57 @@ contains ! info = psb_success_ + nrow = desc_data%get_local_rows() + if (x%get_nrows() < nrow) then + info = 36 + call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/)) + goto 9999 + end if + if (y%get_nrows() < nrow) then + info = 36 + call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/)) + goto 9999 + end if + + call psb_geaxpby(alpha,x,beta,y,desc_data,info) + if (info /= psb_success_ ) then + info = psb_err_from_subroutine_ + call psb_errpush(infoi,name,a_err="psb_geaxpby") + 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 psb_c_null_apply_vect + + subroutine psb_c_null_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) + use psb_base_mod + type(psb_desc_type),intent(in) :: desc_data + class(psb_c_null_prec_type), intent(in) :: prec + complex(psb_spk_),intent(inout) :: x(:) + complex(psb_spk_),intent(in) :: alpha, beta + complex(psb_spk_),intent(inout) :: y(:) + integer, intent(out) :: info + character(len=1), optional :: trans + complex(psb_spk_),intent(inout), optional, target :: work(:) + Integer :: err_act, nrow + character(len=20) :: name='c_null_prec_apply' + + call psb_erractionsave(err_act) + + ! + ! + info = psb_success_ + nrow = desc_data%get_local_rows() if (size(x) < nrow) then info = 36 @@ -103,7 +156,7 @@ contains return end subroutine psb_c_null_precinit - subroutine psb_c_null_precbld(a,desc_a,prec,info,upd,mold,afmt) + subroutine psb_c_null_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold) use psb_base_mod Implicit None @@ -114,7 +167,8 @@ contains integer, intent(out) :: info character, intent(in), optional :: upd character(len=*), intent(in), optional :: afmt - class(psb_c_base_sparse_mat), intent(in), optional :: mold + class(psb_c_base_sparse_mat), intent(in), optional :: amold + class(psb_c_base_vect_type), intent(in), optional :: vmold Integer :: err_act, nrow character(len=20) :: name='c_null_precbld' diff --git a/prec/psb_c_prec_type.f90 b/prec/psb_c_prec_type.f90 index 390cf902a..f76c31d66 100644 --- a/prec/psb_c_prec_type.f90 +++ b/prec/psb_c_prec_type.f90 @@ -47,9 +47,12 @@ module psb_c_prec_type type psb_cprec_type class(psb_c_base_prec_type), allocatable :: prec contains + procedure, pass(prec) :: c_apply1_vect + procedure, pass(prec) :: c_apply2_vect procedure, pass(prec) :: c_apply2v procedure, pass(prec) :: c_apply1v - generic, public :: apply => c_apply2v, c_apply1v + generic, public :: apply => c_apply2v, c_apply1v,& + & c_apply1_vect, c_apply2_vect end type psb_cprec_type interface psb_precfree @@ -64,13 +67,16 @@ module psb_c_prec_type module procedure psb_cfile_prec_descr end interface + interface psb_precdump + module procedure psb_c_prec_dump + end interface + interface psb_sizeof module procedure psb_cprec_sizeof end interface contains - subroutine psb_cfile_prec_descr(p,iout) use psb_base_mod type(psb_cprec_type), intent(in) :: p @@ -92,11 +98,33 @@ contains end subroutine psb_cfile_prec_descr + subroutine psb_c_prec_dump(prec,info,prefix,head) + use psb_base_mod + implicit none + type(psb_cprec_type), intent(in) :: prec + integer, intent(out) :: info + character(len=*), intent(in), optional :: prefix,head + ! len of prefix_ + + info = 0 + + if (.not.allocated(prec%prec)) then + info = -1 + write(psb_err_unit,*) 'Trying to dump a non-built preconditioner' + return + end if + + call prec%prec%dump(info,prefix,head) + + + end subroutine psb_c_prec_dump + + subroutine psb_c_precfree(p,info) use psb_base_mod type(psb_cprec_type), intent(inout) :: p integer, intent(out) :: info - integer :: err_act,i + integer :: me, err_act,i character(len=20) :: name if(psb_get_errstatus() /= 0) return info=psb_success_ @@ -141,7 +169,154 @@ contains end if end function psb_cprec_sizeof + + subroutine c_apply2_vect(prec,x,y,desc_data,info,trans,work) + use psb_base_mod + type(psb_desc_type),intent(in) :: desc_data + class(psb_cprec_type), intent(inout) :: prec + type(psb_c_vect_type),intent(inout) :: x + type(psb_c_vect_type),intent(inout) :: y + integer, intent(out) :: info + character(len=1), optional :: trans + complex(psb_spk_),intent(inout), optional, target :: work(:) + character :: trans_ + complex(psb_spk_), pointer :: work_(:) + integer :: ictxt,np,me,err_act + character(len=20) :: name + + name = 'c_apply2v' + info = psb_success_ + call psb_erractionsave(err_act) + + ictxt = desc_data%get_context() + call psb_info(ictxt, me, np) + + if (present(trans)) then + trans_=psb_toupper(trans) + else + trans_='N' + end if + + if (present(work)) then + work_ => work + else + allocate(work_(4*desc_data%get_local_cols()),stat=info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='Allocate') + goto 9999 + end if + + end if + + if (.not.allocated(prec%prec)) then + info = 1124 + call psb_errpush(info,name,a_err="preconditioner") + goto 9999 + end if + + call prec%prec%apply(cone,x,czero,y,desc_data,info,& + & trans=trans_,work=work_) + + if (present(work)) then + else + deallocate(work_,stat=info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='DeAllocate') + goto 9999 + end if + 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 c_apply2_vect + + subroutine c_apply1_vect(prec,x,desc_data,info,trans,work) + use psb_base_mod + type(psb_desc_type),intent(in) :: desc_data + class(psb_cprec_type), intent(inout) :: prec + type(psb_c_vect_type),intent(inout) :: x + integer, intent(out) :: info + character(len=1), optional :: trans + complex(psb_spk_),intent(inout), optional, target :: work(:) + + type(psb_c_vect_type) :: ww + character :: trans_ + complex(psb_spk_), pointer :: work_(:) + integer :: ictxt,np,me,err_act + character(len=20) :: name + + name = 'c_apply1v' + info = psb_success_ + call psb_erractionsave(err_act) + + ictxt = desc_data%get_context() + call psb_info(ictxt, me, np) + + if (present(trans)) then + trans_=psb_toupper(trans) + else + trans_='N' + end if + + if (present(work)) then + work_ => work + else + allocate(work_(4*desc_data%get_local_cols()),stat=info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='Allocate') + goto 9999 + end if + + end if + + if (.not.allocated(prec%prec)) then + info = 1124 + call psb_errpush(info,name,a_err="preconditioner") + goto 9999 + end if + + call psb_geall(ww,desc_data,info) + if (info == 0) call psb_geasb(ww,desc_data,info,mold=x%v) + if (info == 0) call prec%prec%apply(cone,x,czero,ww,desc_data,info,& + & trans=trans_,work=work_) + if (info == 0) call psb_geaxpby(cone,ww,czero,x,desc_data,info) + + if (present(work)) then + else + deallocate(work_,stat=info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='DeAllocate') + goto 9999 + end if + 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 c_apply1_vect + subroutine c_apply2v(prec,x,y,desc_data,info,trans,work) use psb_base_mod type(psb_desc_type),intent(in) :: desc_data @@ -247,7 +422,8 @@ contains call psb_errpush(info,name,a_err='Allocate') goto 9999 end if - call prec%prec%apply(cone,x,czero,ww,desc_data,info,trans_,work=w1) + call prec%prec%apply(cone,x,czero,ww,desc_data,info,& + & trans_,work=w1) if(info /= psb_success_) goto 9999 x(:) = ww(:) deallocate(ww,W1,stat=info) diff --git a/prec/psb_cprecbld.f90 b/prec/psb_cprecbld.f90 index 75d9a6e6b..f08cacd3b 100644 --- a/prec/psb_cprecbld.f90 +++ b/prec/psb_cprecbld.f90 @@ -29,7 +29,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine psb_cprecbld(a,desc_a,p,info,upd,mold,afmt) +subroutine psb_cprecbld(a,desc_a,p,info,upd,amold,afmt,vmold) use psb_base_mod use psb_prec_mod, psb_protect_name => psb_cprecbld @@ -41,8 +41,8 @@ subroutine psb_cprecbld(a,desc_a,p,info,upd,mold,afmt) integer, intent(out) :: info character, intent(in), optional :: upd character(len=*), intent(in), optional :: afmt - class(psb_c_base_sparse_mat), intent(in), optional :: mold - + class(psb_c_base_sparse_mat), intent(in), optional :: amold + class(psb_c_base_vect_type), intent(in), optional :: vmold ! Local scalars Integer :: err, n_row, n_col,ictxt,& @@ -80,7 +80,9 @@ subroutine psb_cprecbld(a,desc_a,p,info,upd,mold,afmt) goto 9999 end if - call p%prec%precbld(a,desc_a,info,upd=upd,afmt=afmt,mold=mold) + call p%prec%precbld(a,desc_a,info,upd=upd,& + & afmt=afmt,amold=amold,vmold=vmold) + if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) diff --git a/prec/psb_d_base_prec_mod.f90 b/prec/psb_d_base_prec_mod.f90 index 04575ab64..20e62a226 100644 --- a/prec/psb_d_base_prec_mod.f90 +++ b/prec/psb_d_base_prec_mod.f90 @@ -39,7 +39,7 @@ module psb_d_base_prec_mod use psb_base_mod, only : psb_dpk_, psb_spk_, psb_long_int_k_,& & psb_desc_type, psb_sizeof, psb_free, psb_cdfree,& & psb_erractionsave, psb_erractionrestore, psb_error, psb_get_errstatus,& - & psb_dspmat_type + & psb_dspmat_type, psb_d_base_vect, psb_d_vect_type use psb_prec_const_mod @@ -49,7 +49,9 @@ module psb_d_base_prec_mod contains procedure, pass(prec) :: set_ctxt => psb_d_base_set_ctxt procedure, pass(prec) :: get_ctxt => psb_d_base_get_ctxt - procedure, pass(prec) :: apply => psb_d_base_apply + procedure, pass(prec) :: d_apply_v => psb_d_base_apply_vect + procedure, pass(prec) :: d_apply => psb_d_base_apply + generic, public :: apply => d_apply, d_apply_v procedure, pass(prec) :: precbld => psb_d_base_precbld procedure, pass(prec) :: precseti => psb_d_base_precseti procedure, pass(prec) :: precsetr => psb_d_base_precsetr @@ -65,11 +67,47 @@ module psb_d_base_prec_mod private :: psb_d_base_apply, psb_d_base_precbld, psb_d_base_precseti,& & psb_d_base_precsetr, psb_d_base_precsetc, psb_d_base_sizeof,& & psb_d_base_precinit, psb_d_base_precfree, psb_d_base_precdescr,& - & psb_d_base_precdump, psb_d_base_set_ctxt + & psb_d_base_precdump, psb_d_base_set_ctxt, psb_d_base_get_ctxt, & + & psb_d_base_apply_vect - contains + subroutine psb_d_base_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) + use psb_base_mod + type(psb_desc_type),intent(in) :: desc_data + class(psb_d_base_prec_type), intent(inout) :: prec + real(psb_dpk_),intent(in) :: alpha, beta + type(psb_d_vect_type),intent(inout) :: x + type(psb_d_vect_type),intent(inout) :: y + integer, intent(out) :: info + character(len=1), optional :: trans + real(psb_dpk_),intent(inout), optional, target :: work(:) + Integer :: err_act, nrow + character(len=20) :: name='d_base_prec_apply' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + 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 psb_d_base_apply_vect + subroutine psb_d_base_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) use psb_base_mod type(psb_desc_type),intent(in) :: desc_data @@ -138,7 +176,7 @@ contains return end subroutine psb_d_base_precinit - subroutine psb_d_base_precbld(a,desc_a,prec,info,upd,mold,afmt) + subroutine psb_d_base_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold) use psb_base_mod Implicit None @@ -149,7 +187,8 @@ contains integer, intent(out) :: info character, intent(in), optional :: upd character(len=*), intent(in), optional :: afmt - class(psb_d_base_sparse_mat), intent(in), optional :: mold + class(psb_d_base_sparse_mat), intent(in), optional :: amold + class(psb_d_base_vect_type), intent(in), optional :: vmold Integer :: err_act, nrow character(len=20) :: name='d_base_precbld' diff --git a/prec/psb_d_bjacprec.f90 b/prec/psb_d_bjacprec.f90 index 649e13c02..2b8aa1520 100644 --- a/prec/psb_d_bjacprec.f90 +++ b/prec/psb_d_bjacprec.f90 @@ -5,8 +5,10 @@ module psb_d_bjacprec integer, allocatable :: iprcparm(:) type(psb_dspmat_type), allocatable :: av(:) real(psb_dpk_), allocatable :: d(:) + type(psb_d_vect_type), allocatable :: dv contains - procedure, pass(prec) :: apply => psb_d_bjac_apply + procedure, pass(prec) :: d_apply_v => psb_d_bjac_apply_vect + procedure, pass(prec) :: d_apply => psb_d_bjac_apply procedure, pass(prec) :: precbld => psb_d_bjac_precbld procedure, pass(prec) :: precinit => psb_d_bjac_precinit procedure, pass(prec) :: precseti => psb_d_bjac_precseti @@ -21,7 +23,7 @@ module psb_d_bjacprec private :: psb_d_bjac_apply, psb_d_bjac_precbld, psb_d_bjac_precseti,& & psb_d_bjac_precsetr, psb_d_bjac_precsetc, psb_d_bjac_sizeof,& & psb_d_bjac_precinit, psb_d_bjac_precfree, psb_d_bjac_precdescr,& - & psb_d_bjac_dump + & psb_d_bjac_dump, psb_d_bjac_apply_vect character(len=15), parameter, private :: & @@ -31,6 +33,147 @@ module psb_d_bjacprec contains + subroutine psb_d_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) + use psb_base_mod + type(psb_desc_type),intent(in) :: desc_data + class(psb_d_bjac_prec_type), intent(inout) :: prec + real(psb_dpk_),intent(in) :: alpha,beta + type(psb_d_vect_type),intent(inout) :: x + type(psb_d_vect_type),intent(inout) :: y + integer, intent(out) :: info + character(len=1), optional :: trans + real(psb_dpk_),intent(inout), optional, target :: work(:) + + ! Local variables + integer :: n_row,n_col + real(psb_dpk_), pointer :: ww(:), aux(:) + type(psb_d_vect_type) :: wv + integer :: ictxt,np,me, err_act, int_err(5) + integer :: debug_level, debug_unit + character :: trans_ + character(len=20) :: name='d_bjac_prec_apply' + character(len=20) :: ch_err + + info = psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + ictxt = desc_data%get_context() + call psb_info(ictxt, me, np) + + + trans_ = psb_toupper(trans) + select case(trans_) + case('N','T','C') + ! Ok + case default + call psb_errpush(psb_err_iarg_invalid_i_,name) + goto 9999 + end select + + + n_row = desc_data%get_local_rows() + n_col = desc_data%get_local_cols() + + if (x%get_nrows() < n_row) then + info = 36 + call psb_errpush(info,name,i_err=(/2,n_row,0,0,0/)) + goto 9999 + end if + if (y%get_nrows() < n_row) then + info = 36 + call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/)) + goto 9999 + end if + if (.not.allocated(prec%d)) then + info = 1124 + call psb_errpush(info,name,a_err="preconditioner: D") + goto 9999 + end if + if (size(prec%d) < n_row) then + info = 1124 + call psb_errpush(info,name,a_err="preconditioner: D") + goto 9999 + end if + + + if (n_col <= size(work)) then + ww => work(1:n_col) + if ((4*n_col+n_col) <= size(work)) then + aux => work(n_col+1:) + else + allocate(aux(4*n_col),stat=info) + + endif + else + allocate(ww(n_col),aux(4*n_col),stat=info) + endif + if (info == psb_success_) allocate(wv%v,mold=x%v) + + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') + goto 9999 + end if + call wv%bld(n_col) + + select case(prec%iprcparm(psb_f_type_)) + case(psb_f_ilu_n_) + + select case(trans_) + case('N') + call psb_spsm(done,prec%av(psb_l_pr_),x,dzero,wv,desc_data,info,& + & trans=trans_,scale='L',diag=prec%dv,choice=psb_none_,work=aux) + if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_u_pr_),wv,& + & beta,y,desc_data,info,& + & trans=trans_,scale='U',choice=psb_none_, work=aux) + + case('T','C') + call psb_spsm(done,prec%av(psb_u_pr_),x,dzero,wv,desc_data,info,& + & trans=trans_,scale='L',diag=prec%dv,choice=psb_none_, work=aux) + if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_l_pr_),wv,& + & beta,y,desc_data,info,& + & trans=trans_,scale='U',choice=psb_none_,work=aux) + + end select + if (info /= psb_success_) then + ch_err="psb_spsm" + goto 9999 + end if + + + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='Invalid factorization') + goto 9999 + end select + +!!$ call psb_halo(y,desc_data,info,data=psb_comm_mov_) + + if (n_col <= size(work)) then + if ((4*n_col+n_col) <= size(work)) then + else + deallocate(aux) + endif + else + deallocate(ww,aux) + endif + + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_errpush(info,name,i_err=int_err,a_err=ch_err) + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + + + end subroutine psb_d_bjac_apply_vect + subroutine psb_d_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) use psb_base_mod type(psb_desc_type),intent(in) :: desc_data @@ -82,16 +225,16 @@ contains call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/)) goto 9999 end if - if (.not.allocated(prec%d)) then - info = 1124 - call psb_errpush(info,name,a_err="preconditioner: D") - goto 9999 - end if - if (size(prec%d) < n_row) then - info = 1124 - call psb_errpush(info,name,a_err="preconditioner: D") - goto 9999 - end if +!!$ if (.not.allocated(prec%d)) then +!!$ info = 1124 +!!$ call psb_errpush(info,name,a_err="preconditioner: D") +!!$ goto 9999 +!!$ end if +!!$ if (size(prec%d) < n_row) then +!!$ info = 1124 +!!$ call psb_errpush(info,name,a_err="preconditioner: D") +!!$ goto 9999 +!!$ end if if (n_col <= size(work)) then @@ -121,15 +264,17 @@ contains select case(trans_) case('N') call psb_spsm(done,prec%av(psb_l_pr_),x,dzero,ww,desc_data,info,& - & trans=trans_,scale='L',diag=prec%d,choice=psb_none_,work=aux) - if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_u_pr_),ww,beta,y,desc_data,info,& + & trans=trans_,scale='L',diag=prec%dv%v%v,choice=psb_none_,work=aux) + if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_u_pr_),ww,& + & beta,y,desc_data,info,& & trans=trans_,scale='U',choice=psb_none_, work=aux) case('T','C') call psb_spsm(done,prec%av(psb_u_pr_),x,dzero,ww,desc_data,info,& - & trans=trans_,scale='L',diag=prec%d,choice=psb_none_, work=aux) - if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_l_pr_),ww,beta,y,desc_data,info,& - & trans=trans_,scale='U',choice=psb_none_,work=aux) + & trans=trans_,scale='L',diag=prec%dv%v%v,choice=psb_none_, work=aux) + if (info == psb_success_) call psb_spsm(alpha,prec%av(psb_l_pr_),ww,& + & beta,y,desc_data,info,& + & trans=trans_,scale='U',choice=psb_none_,work=aux) end select if (info /= psb_success_) then @@ -210,7 +355,7 @@ contains end subroutine psb_d_bjac_precinit - subroutine psb_d_bjac_precbld(a,desc_a,prec,info,upd,mold,afmt) + subroutine psb_d_bjac_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold) use psb_base_mod use psb_prec_mod, only : psb_ilu_fct @@ -222,13 +367,15 @@ contains integer, intent(out) :: info character, intent(in), optional :: upd character(len=*), intent(in), optional :: afmt - class(psb_d_base_sparse_mat), intent(in), optional :: mold + class(psb_d_base_sparse_mat), intent(in), optional :: amold + class(psb_d_base_vect_type), intent(in), optional :: vmold ! .. Local Scalars .. integer :: i, m integer :: int_err(5) character :: trans, unitd type(psb_d_csr_sparse_mat), allocatable :: lf, uf + real(psb_dpk_), allocatable :: dd(:) integer nztota, err_act, n_row, nrow_a,n_col, nhalo integer :: ictxt,np,me character(len=20) :: name='d_bjac_precbld' @@ -294,21 +441,24 @@ contains goto 9999 end if - if (allocated(prec%d)) then - if (size(prec%d) < n_row) then - deallocate(prec%d) - endif - endif - if (.not.allocated(prec%d)) then - allocate(prec%d(n_row),stat=info) - if (info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') - goto 9999 + allocate(dd(n_row),stat=info) + if (info == psb_success_) then + allocate(prec%dv, stat=info) + if (info == 0) then + if (present(vmold)) then + allocate(prec%dv%v,mold=vmold,stat=info) + else + allocate(psb_d_base_vect_type :: prec%dv%v,stat=info) + end if end if - + end if + + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') + goto 9999 endif ! This is where we have no renumbering, thus no need - call psb_ilu_fct(a,lf,uf,prec%d,info) + call psb_ilu_fct(a,lf,uf,dd,info) if(info == psb_success_) then call prec%av(psb_l_pr_)%mv_from(lf) @@ -317,6 +467,8 @@ contains call prec%av(psb_u_pr_)%set_asb() call prec%av(psb_l_pr_)%trim() call prec%av(psb_u_pr_)%trim() + call prec%dv%bld(dd) + call move_alloc(dd,prec%d) else info=psb_err_from_subroutine_ ch_err='psb_ilu_fct' @@ -337,9 +489,9 @@ contains goto 9999 end select - if (present(mold)) then - call prec%av(psb_l_pr_)%cscnv(info,mold=mold) - call prec%av(psb_u_pr_)%cscnv(info,mold=mold) + if (present(amold)) then + call prec%av(psb_l_pr_)%cscnv(info,mold=amold) + call prec%av(psb_u_pr_)%cscnv(info,mold=amold) else if (present(afmt)) then call prec%av(psb_l_pr_)%cscnv(info,type=afmt) call prec%av(psb_u_pr_)%cscnv(info,type=afmt) @@ -382,15 +534,18 @@ contains select case(what) case (psb_f_type_) if (prec%iprcparm(psb_p_type_) /= psb_bjac_) then - write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',prec%iprcparm(psb_p_type_),& + write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',& + & prec%iprcparm(psb_p_type_),& & 'ignoring user specification' return endif prec%iprcparm(psb_f_type_) = val case (psb_ilu_fill_in_) - if ((prec%iprcparm(psb_p_type_) /= psb_bjac_).or.(prec%iprcparm(psb_f_type_) /= psb_f_ilu_n_)) then - write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',prec%iprcparm(psb_p_type_),& + if ((prec%iprcparm(psb_p_type_) /= psb_bjac_).or.& + & (prec%iprcparm(psb_f_type_) /= psb_f_ilu_n_)) then + write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',& + & prec%iprcparm(psb_p_type_),& & 'ignoring user specification' return endif @@ -492,6 +647,10 @@ contains if (allocated(prec%d)) then deallocate(prec%d,stat=info) end if + if (allocated(prec%dv)) then + call prec%dv%free(info) + if (info == 0) deallocate(prec%dv,stat=info) + end if call psb_erractionrestore(err_act) return diff --git a/prec/psb_d_diagprec.f90 b/prec/psb_d_diagprec.f90 index 261baaac0..9985089bc 100644 --- a/prec/psb_d_diagprec.f90 +++ b/prec/psb_d_diagprec.f90 @@ -1,11 +1,14 @@ module psb_d_diagprec - use psb_d_base_prec_mod + use psb_d_base_prec_mod + type, extends(psb_d_base_prec_type) :: psb_d_diag_prec_type - real(psb_dpk_), allocatable :: d(:) + real(psb_dpk_), allocatable :: d(:) + type(psb_d_vect_type), allocatable :: dv contains - procedure, pass(prec) :: apply => psb_d_diag_apply + procedure, pass(prec) :: d_apply_v => psb_d_diag_apply_vect + procedure, pass(prec) :: d_apply => psb_d_diag_apply procedure, pass(prec) :: precbld => psb_d_diag_precbld procedure, pass(prec) :: precinit => psb_d_diag_precinit procedure, pass(prec) :: precseti => psb_d_diag_precseti @@ -18,12 +21,112 @@ module psb_d_diagprec private :: psb_d_diag_apply, psb_d_diag_precbld, psb_d_diag_precseti,& & psb_d_diag_precsetr, psb_d_diag_precsetc, psb_d_diag_sizeof,& - & psb_d_diag_precinit, psb_d_diag_precfree, psb_d_diag_precdescr + & psb_d_diag_precinit, psb_d_diag_precfree, psb_d_diag_precdescr,& + & psb_d_diag_apply_vect contains + subroutine psb_d_diag_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) + use psb_base_mod + type(psb_desc_type),intent(in) :: desc_data + class(psb_d_diag_prec_type), intent(inout) :: prec + type(psb_d_vect_type),intent(inout) :: x + real(psb_dpk_),intent(in) :: alpha, beta + type(psb_d_vect_type),intent(inout) :: y + integer, intent(out) :: info + character(len=1), optional :: trans + real(psb_dpk_),intent(inout), optional, target :: work(:) + Integer :: err_act, nrow + character(len=20) :: name='d_diag_prec_apply' + real(psb_dpk_), pointer :: ww(:) + class(psb_d_base_vect_type), allocatable :: dw + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the DIAG preonditioner??? + ! + info = psb_success_ + + nrow = desc_data%get_local_rows() + if (x%get_nrows() < nrow) then + info = 36 + call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/)) + goto 9999 + end if + if (y%get_nrows() < nrow) then + info = 36 + call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/)) + goto 9999 + end if + if (.not.allocated(prec%d)) then + info = 1124 + call psb_errpush(info,name,a_err="preconditioner: D") + goto 9999 + end if + if (size(prec%d) < nrow) then + info = 1124 + call psb_errpush(info,name,a_err="preconditioner: D") + goto 9999 + end if + + if (size(work) >= x%get_nrows()) then + ww => work + else + allocate(ww(x%get_nrows()),stat=info) + if (info /= psb_success_) then + call psb_errpush(psb_err_alloc_request_,name,& + & i_err=(/x%get_nrows(),0,0,0,0/),a_err='real(psb_dpk_)') + goto 9999 + end if + end if + +!!$ allocate(dw, mold=x, stat=info) +!!$ call dw%bld(x%get_nrows()) +!!$ if (.true.) then +!!$ if (info == 0) call dw%mlt(prec%dv,x,info) +!!$ else +!!$ if (info == 0) call dw%axpby(nrow,done,x,dzero,info) +!!$ if (info == 0) call dw%mlt(prec%dv,info) +!!$ end if +!!$ if (info == 0) call y%axpby(nrow,alpha,dw,beta,info) + + call y%mlt(alpha,prec%dv,x,beta,info) + +!!$ call x%mlt(ww,prec%d(1:nrow),info) +!!$ if (info == 0) call psb_geaxpby(alpha,ww,beta,y,desc_data,info) + +!!$ call dw%free(info) +!!$ if (info /= psb_success_) then +!!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='Deallocate') +!!$ goto 9999 +!!$ end if + + if (size(work) < x%get_nrows()) then + deallocate(ww,stat=info) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='Deallocate') + goto 9999 + end if + 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 psb_d_diag_apply_vect + + subroutine psb_d_diag_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) use psb_base_mod type(psb_desc_type),intent(in) :: desc_data @@ -131,7 +234,7 @@ contains end subroutine psb_d_diag_precinit - subroutine psb_d_diag_precbld(a,desc_a,prec,info,upd,mold,afmt) + subroutine psb_d_diag_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold) use psb_base_mod Implicit None @@ -142,7 +245,8 @@ contains integer, intent(out) :: info character, intent(in), optional :: upd character(len=*), intent(in), optional :: afmt - class(psb_d_base_sparse_mat), intent(in), optional :: mold + class(psb_d_base_sparse_mat), intent(in), optional :: amold + class(psb_d_base_vect_type), intent(in), optional :: vmold Integer :: err_act, nrow,i character(len=20) :: name='d_diag_precbld' @@ -178,7 +282,20 @@ contains prec%d(i) = done/prec%d(i) endif end do - + allocate(prec%dv,stat=info) + if (info == 0) then + if (present(vmold)) then + allocate(prec%dv%v,mold=vmold,stat=info) + else + allocate(psb_d_base_vect_type :: prec%dv%v,stat=info) + end if + end if + if (info == 0) then + call prec%dv%bld(prec%d) + else + write(0,*) 'Error on precbld ',info + end if + call psb_erractionrestore(err_act) return diff --git a/prec/psb_d_nullprec.f90 b/prec/psb_d_nullprec.f90 index 7350a4d1d..dca62adc8 100644 --- a/prec/psb_d_nullprec.f90 +++ b/prec/psb_d_nullprec.f90 @@ -4,7 +4,8 @@ module psb_d_nullprec type, extends(psb_d_base_prec_type) :: psb_d_null_prec_type contains - procedure, pass(prec) :: apply => psb_d_null_apply + procedure, pass(prec) :: d_apply_v => psb_d_null_apply_vect + procedure, pass(prec) :: d_apply => psb_d_null_apply procedure, pass(prec) :: precbld => psb_d_null_precbld procedure, pass(prec) :: precinit => psb_d_null_precinit procedure, pass(prec) :: precseti => psb_d_null_precseti @@ -17,11 +18,65 @@ module psb_d_nullprec private :: psb_d_null_apply, psb_d_null_precbld, psb_d_null_precseti,& & psb_d_null_precsetr, psb_d_null_precsetc, psb_d_null_sizeof,& - & psb_d_null_precinit, psb_d_null_precfree, psb_d_null_precdescr + & psb_d_null_precinit, psb_d_null_precfree, psb_d_null_precdescr, & + & psb_d_null_apply_vect contains + subroutine psb_d_null_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) + use psb_base_mod + type(psb_desc_type),intent(in) :: desc_data + class(psb_d_null_prec_type), intent(inout) :: prec + type(psb_d_vect_type),intent(inout) :: x + real(psb_dpk_),intent(in) :: alpha, beta + type(psb_d_vect_type),intent(inout) :: y + integer, intent(out) :: info + character(len=1), optional :: trans + real(psb_dpk_),intent(inout), optional, target :: work(:) + Integer :: err_act, nrow + character(len=20) :: name='d_null_prec_apply' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = psb_success_ + + nrow = desc_data%get_local_rows() + if (x%get_nrows() < nrow) then + info = 36 + call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/)) + goto 9999 + end if + if (y%get_nrows() < nrow) then + info = 36 + call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/)) + goto 9999 + end if + + call psb_geaxpby(alpha,x,beta,y,desc_data,info) + if (info /= psb_success_ ) then + info = psb_err_from_subroutine_ + call psb_errpush(infoi,name,a_err="psb_geaxpby") + 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 psb_d_null_apply_vect + subroutine psb_d_null_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) use psb_base_mod type(psb_desc_type),intent(in) :: desc_data @@ -103,7 +158,7 @@ contains return end subroutine psb_d_null_precinit - subroutine psb_d_null_precbld(a,desc_a,prec,info,upd,mold,afmt) + subroutine psb_d_null_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold) use psb_base_mod Implicit None @@ -114,7 +169,8 @@ contains integer, intent(out) :: info character, intent(in), optional :: upd character(len=*), intent(in), optional :: afmt - class(psb_d_base_sparse_mat), intent(in), optional :: mold + class(psb_d_base_sparse_mat), intent(in), optional :: amold + class(psb_d_base_vect_type), intent(in), optional :: vmold Integer :: err_act, nrow character(len=20) :: name='d_null_precbld' diff --git a/prec/psb_d_prec_type.f90 b/prec/psb_d_prec_type.f90 index 8ef0ad97a..bea39e373 100644 --- a/prec/psb_d_prec_type.f90 +++ b/prec/psb_d_prec_type.f90 @@ -48,9 +48,12 @@ module psb_d_prec_type type psb_dprec_type class(psb_d_base_prec_type), allocatable :: prec contains + procedure, pass(prec) :: d_apply1_vect + procedure, pass(prec) :: d_apply2_vect procedure, pass(prec) :: d_apply2v procedure, pass(prec) :: d_apply1v - generic, public :: apply => d_apply2v, d_apply1v + generic, public :: apply => d_apply2v, d_apply1v,& + & d_apply1_vect, d_apply2_vect end type psb_dprec_type interface psb_precfree @@ -174,6 +177,154 @@ contains end function psb_dprec_sizeof + subroutine d_apply2_vect(prec,x,y,desc_data,info,trans,work) + use psb_base_mod + type(psb_desc_type),intent(in) :: desc_data + class(psb_dprec_type), intent(inout) :: prec + type(psb_d_vect_type),intent(inout) :: x + type(psb_d_vect_type),intent(inout) :: y + integer, intent(out) :: info + character(len=1), optional :: trans + real(psb_dpk_),intent(inout), optional, target :: work(:) + + character :: trans_ + real(psb_dpk_), pointer :: work_(:) + integer :: ictxt,np,me,err_act + character(len=20) :: name + + name='d_apply2v' + info = psb_success_ + call psb_erractionsave(err_act) + + ictxt = desc_data%get_context() + call psb_info(ictxt, me, np) + + if (present(trans)) then + trans_=psb_toupper(trans) + else + trans_='N' + end if + + if (present(work)) then + work_ => work + else + allocate(work_(4*desc_data%get_local_cols()),stat=info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='Allocate') + goto 9999 + end if + + end if + + if (.not.allocated(prec%prec)) then + info = 1124 + call psb_errpush(info,name,a_err="preconditioner") + goto 9999 + end if + + call prec%prec%apply(done,x,dzero,y,desc_data,info,& + & trans=trans_,work=work_) + + if (present(work)) then + else + deallocate(work_,stat=info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='DeAllocate') + goto 9999 + end if + 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_apply2_vect + + + subroutine d_apply1_vect(prec,x,desc_data,info,trans,work) + use psb_base_mod + type(psb_desc_type),intent(in) :: desc_data + class(psb_dprec_type), intent(inout) :: prec + type(psb_d_vect_type),intent(inout) :: x + integer, intent(out) :: info + character(len=1), optional :: trans + real(psb_dpk_),intent(inout), optional, target :: work(:) + + type(psb_d_vect_type) :: ww + character :: trans_ + real(psb_dpk_), pointer :: work_(:) + integer :: ictxt,np,me,err_act + character(len=20) :: name + + name='d_apply1v' + info = psb_success_ + call psb_erractionsave(err_act) + + ictxt = desc_data%get_context() + call psb_info(ictxt, me, np) + + if (present(trans)) then + trans_=psb_toupper(trans) + else + trans_='N' + end if + + if (present(work)) then + work_ => work + else + allocate(work_(4*desc_data%get_local_cols()),stat=info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='Allocate') + goto 9999 + end if + + end if + + if (.not.allocated(prec%prec)) then + info = 1124 + call psb_errpush(info,name,a_err="preconditioner") + goto 9999 + end if + + call psb_geall(ww,desc_data,info) + if (info == 0) call psb_geasb(ww,desc_data,info,mold=x%v) + if (info == 0) call prec%prec%apply(done,x,dzero,ww,desc_data,info,& + & trans=trans_,work=work_) + if (info == 0) call psb_geaxpby(done,ww,dzero,x,desc_data,info) + + if (present(work)) then + else + deallocate(work_,stat=info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='DeAllocate') + goto 9999 + end if + 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_apply1_vect + subroutine d_apply2v(prec,x,y,desc_data,info,trans,work) use psb_base_mod type(psb_desc_type),intent(in) :: desc_data @@ -219,7 +370,8 @@ contains call psb_errpush(info,name,a_err="preconditioner") goto 9999 end if - call prec%prec%apply(done,x,dzero,y,desc_data,info,trans=trans_,work=work_) + call prec%prec%apply(done,x,dzero,y,desc_data,info,& + & trans=trans_,work=work_) if (present(work)) then else deallocate(work_,stat=info) @@ -279,7 +431,8 @@ contains call psb_errpush(info,name,a_err='Allocate') goto 9999 end if - call prec%prec%apply(done,x,dzero,ww,desc_data,info,trans=trans_,work=w1) + call prec%prec%apply(done,x,dzero,ww,desc_data,info,& + & trans=trans_,work=w1) if(info /= psb_success_) goto 9999 x(:) = ww(:) deallocate(ww,W1,stat=info) diff --git a/prec/psb_dprecbld.f90 b/prec/psb_dprecbld.f90 index c0021adc7..aaeecb084 100644 --- a/prec/psb_dprecbld.f90 +++ b/prec/psb_dprecbld.f90 @@ -29,7 +29,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine psb_dprecbld(a,desc_a,p,info,upd,mold,afmt) +subroutine psb_dprecbld(a,desc_a,p,info,upd,amold,afmt,vmold) use psb_base_mod use psb_prec_mod, psb_protect_name => psb_dprecbld @@ -41,7 +41,8 @@ subroutine psb_dprecbld(a,desc_a,p,info,upd,mold,afmt) integer, intent(out) :: info character, intent(in), optional :: upd character(len=*), intent(in), optional :: afmt - class(psb_d_base_sparse_mat), intent(in), optional :: mold + class(psb_d_base_sparse_mat), intent(in), optional :: amold + class(psb_d_base_vect_type), intent(in), optional :: vmold ! Local scalars Integer :: err, n_row, n_col,ictxt,& @@ -79,7 +80,8 @@ subroutine psb_dprecbld(a,desc_a,p,info,upd,mold,afmt) goto 9999 end if - call p%prec%precbld(a,desc_a,info,upd=upd,afmt=afmt,mold=mold) + call p%prec%precbld(a,desc_a,info,upd=upd,& + & afmt=afmt,amold=amold,vmold=vmold) if (info /= psb_success_) goto 9999 diff --git a/prec/psb_s_base_prec_mod.f90 b/prec/psb_s_base_prec_mod.f90 index d578477d7..d37f04397 100644 --- a/prec/psb_s_base_prec_mod.f90 +++ b/prec/psb_s_base_prec_mod.f90 @@ -39,13 +39,19 @@ module psb_s_base_prec_mod use psb_base_mod, only : psb_dpk_, psb_spk_, psb_long_int_k_,& & psb_desc_type, psb_sizeof, psb_free, psb_cdfree,& & psb_erractionsave, psb_erractionrestore, psb_error, psb_get_errstatus,& - & psb_sspmat_type + & psb_sspmat_type, psb_s_base_vect, psb_s_vect_type + use psb_prec_const_mod type psb_s_base_prec_type + integer :: ictxt contains - procedure, pass(prec) :: apply => psb_s_base_apply + procedure, pass(prec) :: set_ctxt => psb_s_base_set_ctxt + procedure, pass(prec) :: get_ctxt => psb_s_base_get_ctxt + procedure, pass(prec) :: s_apply_v => psb_s_base_apply_vect + procedure, pass(prec) :: s_apply => psb_s_base_apply + generic, public :: apply => s_apply, s_apply_v procedure, pass(prec) :: precbld => psb_s_base_precbld procedure, pass(prec) :: precseti => psb_s_base_precseti procedure, pass(prec) :: precsetr => psb_s_base_precsetr @@ -55,14 +61,52 @@ module psb_s_base_prec_mod procedure, pass(prec) :: precinit => psb_s_base_precinit procedure, pass(prec) :: precfree => psb_s_base_precfree procedure, pass(prec) :: precdescr => psb_s_base_precdescr + procedure, pass(prec) :: dump => psb_s_base_precdump end type psb_s_base_prec_type private :: psb_s_base_apply, psb_s_base_precbld, psb_s_base_precseti,& & psb_s_base_precsetr, psb_s_base_precsetc, psb_s_base_sizeof,& - & psb_s_base_precinit, psb_s_base_precfree, psb_s_base_precdescr + & psb_s_base_precinit, psb_s_base_precfree, psb_s_base_precdescr,& + & psb_s_base_precdump, psb_s_base_set_ctxt, psb_s_base_get_ctxt, & + & psb_s_base_apply_vect contains + subroutine psb_s_base_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) + use psb_base_mod + type(psb_desc_type),intent(in) :: desc_data + class(psb_s_base_prec_type), intent(inout) :: prec + real(psb_spk_),intent(in) :: alpha, beta + type(psb_s_vect_type),intent(inout) :: x + type(psb_s_vect_type),intent(inout) :: y + integer, intent(out) :: info + character(len=1), optional :: trans + real(psb_spk_),intent(inout), optional, target :: work(:) + Integer :: err_act, nrow + character(len=20) :: name='d_base_prec_apply' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + 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 psb_s_base_apply_vect subroutine psb_s_base_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) use psb_base_mod @@ -132,18 +176,19 @@ contains return end subroutine psb_s_base_precinit - subroutine psb_s_base_precbld(a,desc_a,prec,info,upd,mold,afmt) + subroutine psb_s_base_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold) use psb_base_mod Implicit None type(psb_sspmat_type), intent(in), target :: a - type(psb_desc_type), intent(in), target :: desc_a + type(psb_desc_type), intent(in), target :: desc_a class(psb_s_base_prec_type),intent(inout) :: prec - integer, intent(out) :: info - character, intent(in), optional :: upd + integer, intent(out) :: info + character, intent(in), optional :: upd character(len=*), intent(in), optional :: afmt - class(psb_s_base_sparse_mat), intent(in), optional :: mold + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold Integer :: err_act, nrow character(len=20) :: name='s_base_precbld' @@ -340,6 +385,47 @@ contains end subroutine psb_s_base_precdescr + subroutine psb_s_base_precdump(prec,info,prefix,head) + use psb_base_mod + implicit none + class(psb_s_base_prec_type), intent(in) :: prec + integer, intent(out) :: info + character(len=*), intent(in), optional :: prefix,head + Integer :: err_act, nrow + character(len=20) :: name='d_base_precdump' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + 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 psb_s_base_precdump + + subroutine psb_s_base_set_ctxt(prec,ictxt) + use psb_base_mod + implicit none + class(psb_s_base_prec_type), intent(inout) :: prec + integer, intent(in) :: ictxt + + prec%ictxt = ictxt + + end subroutine psb_s_base_set_ctxt function psb_s_base_sizeof(prec) result(val) use psb_base_mod @@ -350,5 +436,13 @@ contains return end function psb_s_base_sizeof + function psb_s_base_get_ctxt(prec) result(val) + use psb_base_mod + class(psb_s_base_prec_type), intent(in) :: prec + integer :: val + + val = prec%ictxt + return + end function psb_s_base_get_ctxt end module psb_s_base_prec_mod diff --git a/prec/psb_s_bjacprec.f90 b/prec/psb_s_bjacprec.f90 index 868a4e81b..bdfa76fd1 100644 --- a/prec/psb_s_bjacprec.f90 +++ b/prec/psb_s_bjacprec.f90 @@ -6,8 +6,10 @@ module psb_s_bjacprec integer, allocatable :: iprcparm(:) type(psb_sspmat_type), allocatable :: av(:) real(psb_spk_), allocatable :: d(:) + type(psb_s_vect_type), allocatable :: dv contains - procedure, pass(prec) :: apply => psb_s_bjac_apply + procedure, pass(prec) :: s_apply_v => psb_s_bjac_apply_vect + procedure, pass(prec) :: s_apply => psb_s_bjac_apply procedure, pass(prec) :: precbld => psb_s_bjac_precbld procedure, pass(prec) :: precinit => psb_s_bjac_precinit procedure, pass(prec) :: precseti => psb_s_bjac_precseti @@ -15,12 +17,14 @@ module psb_s_bjacprec procedure, pass(prec) :: precsetc => psb_s_bjac_precsetc procedure, pass(prec) :: precfree => psb_s_bjac_precfree procedure, pass(prec) :: precdescr => psb_s_bjac_precdescr + procedure, pass(prec) :: dump => psb_s_bjac_dump procedure, pass(prec) :: sizeof => psb_s_bjac_sizeof end type psb_s_bjac_prec_type private :: psb_s_bjac_apply, psb_s_bjac_precbld, psb_s_bjac_precseti,& & psb_s_bjac_precsetr, psb_s_bjac_precsetc, psb_s_bjac_sizeof,& - & psb_s_bjac_precinit, psb_s_bjac_precfree, psb_s_bjac_precdescr + & psb_s_bjac_precinit, psb_s_bjac_precfree, psb_s_bjac_precdescr,& + & psb_s_bjac_dump, psb_s_bjac_apply_vect character(len=15), parameter, private :: & @@ -30,6 +34,147 @@ module psb_s_bjacprec contains + subroutine psb_s_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) + use psb_base_mod + type(psb_desc_type),intent(in) :: desc_data + class(psb_s_bjac_prec_type), intent(inout) :: prec + real(psb_spk_),intent(in) :: alpha,beta + type(psb_s_vect_type),intent(inout) :: x + type(psb_s_vect_type),intent(inout) :: y + integer, intent(out) :: info + character(len=1), optional :: trans + real(psb_spk_),intent(inout), optional, target :: work(:) + + ! Local variables + integer :: n_row,n_col + real(psb_spk_), pointer :: ww(:), aux(:) + type(psb_s_vect_type) :: wv + integer :: ictxt,np,me, err_act, int_err(5) + integer :: debug_level, debug_unit + character :: trans_ + character(len=20) :: name='d_bjac_prec_apply' + character(len=20) :: ch_err + + info = psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + ictxt = desc_data%get_context() + call psb_info(ictxt, me, np) + + + trans_ = psb_toupper(trans) + select case(trans_) + case('N','T','C') + ! Ok + case default + call psb_errpush(psb_err_iarg_invalid_i_,name) + goto 9999 + end select + + + n_row = desc_data%get_local_rows() + n_col = desc_data%get_local_cols() + + if (x%get_nrows() < n_row) then + info = 36 + call psb_errpush(info,name,i_err=(/2,n_row,0,0,0/)) + goto 9999 + end if + if (y%get_nrows() < n_row) then + info = 36 + call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/)) + goto 9999 + end if + if (.not.allocated(prec%d)) then + info = 1124 + call psb_errpush(info,name,a_err="preconditioner: D") + goto 9999 + end if + if (size(prec%d) < n_row) then + info = 1124 + call psb_errpush(info,name,a_err="preconditioner: D") + goto 9999 + end if + + + if (n_col <= size(work)) then + ww => work(1:n_col) + if ((4*n_col+n_col) <= size(work)) then + aux => work(n_col+1:) + else + allocate(aux(4*n_col),stat=info) + + endif + else + allocate(ww(n_col),aux(4*n_col),stat=info) + endif + if (info == psb_success_) allocate(wv%v,mold=x%v) + + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') + goto 9999 + end if + call wv%bld(n_col) + + select case(prec%iprcparm(psb_f_type_)) + case(psb_f_ilu_n_) + + select case(trans_) + case('N') + call psb_spsm(sone,prec%av(psb_l_pr_),x,szero,wv,desc_data,info,& + & trans=trans_,scale='L',diag=prec%dv,choice=psb_none_,work=aux) + if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_u_pr_),wv,& + & beta,y,desc_data,info,& + & trans=trans_,scale='U',choice=psb_none_, work=aux) + + case('T','C') + call psb_spsm(sone,prec%av(psb_u_pr_),x,szero,wv,desc_data,info,& + & trans=trans_,scale='L',diag=prec%dv,choice=psb_none_, work=aux) + if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_l_pr_),wv,& + & beta,y,desc_data,info,& + & trans=trans_,scale='U',choice=psb_none_,work=aux) + + end select + if (info /= psb_success_) then + ch_err="psb_spsm" + goto 9999 + end if + + + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='Invalid factorization') + goto 9999 + end select + +!!$ call psb_halo(y,desc_data,info,data=psb_comm_mov_) + + if (n_col <= size(work)) then + if ((4*n_col+n_col) <= size(work)) then + else + deallocate(aux) + endif + else + deallocate(ww,aux) + endif + + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_errpush(info,name,i_err=int_err,a_err=ch_err) + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + + + end subroutine psb_s_bjac_apply_vect + subroutine psb_s_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) use psb_base_mod type(psb_desc_type),intent(in) :: desc_data @@ -81,16 +226,16 @@ contains call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/)) goto 9999 end if - if (.not.allocated(prec%d)) then - info = 1124 - call psb_errpush(info,name,a_err="preconditioner: D") - goto 9999 - end if - if (size(prec%d) < n_row) then - info = 1124 - call psb_errpush(info,name,a_err="preconditioner: D") - goto 9999 - end if +!!$ if (.not.allocated(prec%d)) then +!!$ info = 1124 +!!$ call psb_errpush(info,name,a_err="preconditioner: D") +!!$ goto 9999 +!!$ end if +!!$ if (size(prec%d) < n_row) then +!!$ info = 1124 +!!$ call psb_errpush(info,name,a_err="preconditioner: D") +!!$ goto 9999 +!!$ end if if (n_col <= size(work)) then @@ -120,15 +265,17 @@ contains select case(trans_) case('N') call psb_spsm(sone,prec%av(psb_l_pr_),x,szero,ww,desc_data,info,& - & trans=trans_,scale='L',diag=prec%d,choice=psb_none_,work=aux) - if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_u_pr_),ww,beta,y,desc_data,info,& + & trans=trans_,scale='L',diag=prec%dv%v%v,choice=psb_none_,work=aux) + if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_u_pr_),ww,& + & beta,y,desc_data,info,& & trans=trans_,scale='U',choice=psb_none_, work=aux) case('T','C') call psb_spsm(sone,prec%av(psb_u_pr_),x,szero,ww,desc_data,info,& - & trans=trans_,scale='L',diag=prec%d,choice=psb_none_, work=aux) - if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_l_pr_),ww,beta,y,desc_data,info,& - & trans=trans_,scale='U',choice=psb_none_,work=aux) + & trans=trans_,scale='L',diag=prec%dv%v%v,choice=psb_none_, work=aux) + if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_l_pr_),ww,& + & beta,y,desc_data,info,& + & trans=trans_,scale='U',choice=psb_none_,work=aux) end select if (info /= psb_success_) then @@ -209,7 +356,7 @@ contains end subroutine psb_s_bjac_precinit - subroutine psb_s_bjac_precbld(a,desc_a,prec,info,upd,mold,afmt) + subroutine psb_s_bjac_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold) use psb_base_mod use psb_prec_mod, only : psb_ilu_fct @@ -221,13 +368,15 @@ contains integer, intent(out) :: info character, intent(in), optional :: upd character(len=*), intent(in), optional :: afmt - class(psb_s_base_sparse_mat), intent(in), optional :: mold + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold ! .. Local Scalars .. integer :: i, m integer :: int_err(5) character :: trans, unitd type(psb_s_csr_sparse_mat), allocatable :: lf, uf + real(psb_spk_), allocatable :: dd(:) integer nztota, err_act, n_row, nrow_a,n_col, nhalo integer :: ictxt,np,me character(len=20) :: name='s_bjac_precbld' @@ -242,6 +391,8 @@ contains ictxt=desc_a%get_context() call psb_info(ictxt, me, np) + call prec%set_ctxt(ictxt) + m = a%get_nrows() if (m < 0) then info = psb_err_iarg_neg_ @@ -291,21 +442,24 @@ contains goto 9999 end if - if (allocated(prec%d)) then - if (size(prec%d) < n_row) then - deallocate(prec%d) - endif - endif - if (.not.allocated(prec%d)) then - allocate(prec%d(n_row),stat=info) - if (info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') - goto 9999 + allocate(dd(n_row),stat=info) + if (info == psb_success_) then + allocate(prec%dv, stat=info) + if (info == 0) then + if (present(vmold)) then + allocate(prec%dv%v,mold=vmold,stat=info) + else + allocate(psb_s_base_vect_type :: prec%dv%v,stat=info) + end if end if - + end if + + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') + goto 9999 endif ! This is where we have no renumbering, thus no need - call psb_ilu_fct(a,lf,uf,prec%d,info) + call psb_ilu_fct(a,lf,uf,dd,info) if(info == psb_success_) then call prec%av(psb_l_pr_)%mv_from(lf) @@ -314,13 +468,15 @@ contains call prec%av(psb_u_pr_)%set_asb() call prec%av(psb_l_pr_)%trim() call prec%av(psb_u_pr_)%trim() + call prec%dv%bld(dd) + call move_alloc(dd,prec%d) else info=psb_err_from_subroutine_ ch_err='psb_ilu_fct' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - + case(psb_f_none_) info=psb_err_from_subroutine_ ch_err='Inconsistent prec psb_f_none_' @@ -334,15 +490,14 @@ contains goto 9999 end select - if (present(mold)) then - call prec%av(psb_l_pr_)%cscnv(info,mold=mold) - call prec%av(psb_u_pr_)%cscnv(info,mold=mold) + if (present(amold)) then + call prec%av(psb_l_pr_)%cscnv(info,mold=amold) + call prec%av(psb_u_pr_)%cscnv(info,mold=amold) else if (present(afmt)) then call prec%av(psb_l_pr_)%cscnv(info,type=afmt) call prec%av(psb_u_pr_)%cscnv(info,type=afmt) end if - call psb_erractionrestore(err_act) return @@ -380,15 +535,18 @@ contains select case(what) case (psb_f_type_) if (prec%iprcparm(psb_p_type_) /= psb_bjac_) then - write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',prec%iprcparm(psb_p_type_),& + write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',& + & prec%iprcparm(psb_p_type_),& & 'ignoring user specification' return endif prec%iprcparm(psb_f_type_) = val case (psb_ilu_fill_in_) - if ((prec%iprcparm(psb_p_type_) /= psb_bjac_).or.(prec%iprcparm(psb_f_type_) /= psb_f_ilu_n_)) then - write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',prec%iprcparm(psb_p_type_),& + if ((prec%iprcparm(psb_p_type_) /= psb_bjac_).or.& + & (prec%iprcparm(psb_f_type_) /= psb_f_ilu_n_)) then + write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',& + & prec%iprcparm(psb_p_type_),& & 'ignoring user specification' return endif @@ -490,6 +648,10 @@ contains if (allocated(prec%d)) then deallocate(prec%d,stat=info) end if + if (allocated(prec%dv)) then + call prec%dv%free(info) + if (info == 0) deallocate(prec%dv,stat=info) + end if call psb_erractionrestore(err_act) return @@ -552,6 +714,46 @@ contains end subroutine psb_s_bjac_precdescr + + subroutine psb_s_bjac_dump(prec,info,prefix,head) + use psb_base_mod + implicit none + class(psb_s_bjac_prec_type), intent(in) :: prec + integer, intent(out) :: info + character(len=*), intent(in), optional :: prefix,head + integer :: i, j, il1, iln, lname, lev + integer :: ictxt,iam, np + character(len=80) :: prefix_ + character(len=120) :: fname ! len should be at least 20 more than + + ! len of prefix_ + + info = 0 + ictxt = prec%get_ctxt() + call psb_info(ictxt,iam,np) + + if (present(prefix)) then + prefix_ = trim(prefix(1:min(len(prefix),len(prefix_)))) + else + prefix_ = "dump_fact_d" + end if + + lname = len_trim(prefix_) + fname = trim(prefix_) + write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam + lname = lname + 5 + write(fname(lname+1:),'(a)')'_lower.mtx' + if (prec%av(psb_l_pr_)%is_asb()) & + & call prec%av(psb_l_pr_)%print(fname,head=head) + write(fname(lname+1:),'(a,a)')'_diag.mtx' + if (allocated(prec%d)) & + & call psb_geprt(fname,prec%d,head=head) + write(fname(lname+1:),'(a)')'_upper.mtx' + if (prec%av(psb_u_pr_)%is_asb()) & + & call prec%av(psb_u_pr_)%print(fname,head=head) + + end subroutine psb_s_bjac_dump + function psb_s_bjac_sizeof(prec) result(val) use psb_base_mod class(psb_s_bjac_prec_type), intent(in) :: prec diff --git a/prec/psb_s_diagprec.f90 b/prec/psb_s_diagprec.f90 index 814b65460..ba498fb06 100644 --- a/prec/psb_s_diagprec.f90 +++ b/prec/psb_s_diagprec.f90 @@ -3,9 +3,11 @@ module psb_s_diagprec use psb_s_base_prec_mod type, extends(psb_s_base_prec_type) :: psb_s_diag_prec_type - real(psb_spk_), allocatable :: d(:) + real(psb_spk_), allocatable :: d(:) + type(psb_s_vect_type), allocatable :: dv contains - procedure, pass(prec) :: apply => psb_s_diag_apply + procedure, pass(prec) :: s_apply_v => psb_s_diag_apply_vect + procedure, pass(prec) :: s_apply => psb_s_diag_apply procedure, pass(prec) :: precbld => psb_s_diag_precbld procedure, pass(prec) :: precinit => psb_s_diag_precinit procedure, pass(prec) :: precseti => psb_s_diag_precseti @@ -18,12 +20,112 @@ module psb_s_diagprec private :: psb_s_diag_apply, psb_s_diag_precbld, psb_s_diag_precseti,& & psb_s_diag_precsetr, psb_s_diag_precsetc, psb_s_diag_sizeof,& - & psb_s_diag_precinit, psb_s_diag_precfree, psb_s_diag_precdescr + & psb_s_diag_precinit, psb_s_diag_precfree, psb_s_diag_precdescr,& + & psb_s_diag_apply_vect contains + subroutine psb_s_diag_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) + use psb_base_mod + type(psb_desc_type),intent(in) :: desc_data + class(psb_s_diag_prec_type), intent(inout) :: prec + type(psb_s_vect_type),intent(inout) :: x + real(psb_spk_),intent(in) :: alpha, beta + type(psb_s_vect_type),intent(inout) :: y + integer, intent(out) :: info + character(len=1), optional :: trans + real(psb_spk_),intent(inout), optional, target :: work(:) + Integer :: err_act, nrow + character(len=20) :: name='d_diag_prec_apply' + real(psb_spk_), pointer :: ww(:) + class(psb_s_base_vect_type), allocatable :: dw + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the DIAG preonditioner??? + ! + info = psb_success_ + + nrow = desc_data%get_local_rows() + if (x%get_nrows() < nrow) then + info = 36 + call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/)) + goto 9999 + end if + if (y%get_nrows() < nrow) then + info = 36 + call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/)) + goto 9999 + end if + if (.not.allocated(prec%d)) then + info = 1124 + call psb_errpush(info,name,a_err="preconditioner: D") + goto 9999 + end if + if (size(prec%d) < nrow) then + info = 1124 + call psb_errpush(info,name,a_err="preconditioner: D") + goto 9999 + end if + + if (size(work) >= x%get_nrows()) then + ww => work + else + allocate(ww(x%get_nrows()),stat=info) + if (info /= psb_success_) then + call psb_errpush(psb_err_alloc_request_,name,& + & i_err=(/x%get_nrows(),0,0,0,0/),a_err='real(psb_spk_)') + goto 9999 + end if + end if + +!!$ allocate(dw, mold=x, stat=info) +!!$ call dw%bld(x%get_nrows()) +!!$ if (.true.) then +!!$ if (info == 0) call dw%mlt(prec%dv,x,info) +!!$ else +!!$ if (info == 0) call dw%axpby(nrow,done,x,dzero,info) +!!$ if (info == 0) call dw%mlt(prec%dv,info) +!!$ end if +!!$ if (info == 0) call y%axpby(nrow,alpha,dw,beta,info) + + call y%mlt(alpha,prec%dv,x,beta,info) + +!!$ call x%mlt(ww,prec%d(1:nrow),info) +!!$ if (info == 0) call psb_geaxpby(alpha,ww,beta,y,desc_data,info) + +!!$ call dw%free(info) +!!$ if (info /= psb_success_) then +!!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='Deallocate') +!!$ goto 9999 +!!$ end if + + if (size(work) < x%get_nrows()) then + deallocate(ww,stat=info) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='Deallocate') + goto 9999 + end if + 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 psb_s_diag_apply_vect + + subroutine psb_s_diag_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) use psb_base_mod type(psb_desc_type),intent(in) :: desc_data @@ -35,6 +137,7 @@ contains character(len=1), optional :: trans real(psb_spk_),intent(inout), optional, target :: work(:) Integer :: err_act, nrow + character :: trans_ character(len=20) :: name='s_diag_prec_apply' real(psb_spk_), pointer :: ww(:) @@ -67,13 +170,29 @@ contains call psb_errpush(info,name,a_err="preconditioner: D") goto 9999 end if + if (present(trans)) then + trans_ = psb_toupper(trans) + else + trans_='N' + end if + + select case(trans_) + case('N') + case('T','C') + case default + info=psb_err_iarg_invalid_i_ + call psb_errpush(info,name,& + & i_err=(/6,0,0,0,0/),a_err=trans_) + goto 9999 + end select if (size(work) >= size(x)) then ww => work else allocate(ww(size(x)),stat=info) if (info /= psb_success_) then - call psb_errpush(psb_err_alloc_request_,name,i_err=(/size(x),0,0,0,0/),a_err='real(psb_spk_)') + call psb_errpush(psb_err_alloc_request_,name,& + & i_err=(/size(x),0,0,0,0/),a_err='real(psb_spk_)') goto 9999 end if end if @@ -130,7 +249,7 @@ contains end subroutine psb_s_diag_precinit - subroutine psb_s_diag_precbld(a,desc_a,prec,info,upd,mold,afmt) + subroutine psb_s_diag_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold) use psb_base_mod Implicit None @@ -141,7 +260,8 @@ contains integer, intent(out) :: info character, intent(in), optional :: upd character(len=*), intent(in), optional :: afmt - class(psb_s_base_sparse_mat), intent(in), optional :: mold + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold Integer :: err_act, nrow,i character(len=20) :: name='s_diag_precbld' @@ -177,7 +297,20 @@ contains prec%d(i) = done/prec%d(i) endif end do - + allocate(prec%dv,stat=info) + if (info == 0) then + if (present(vmold)) then + allocate(prec%dv%v,mold=vmold,stat=info) + else + allocate(psb_s_base_vect_type :: prec%dv%v,stat=info) + end if + end if + if (info == 0) then + call prec%dv%bld(prec%d) + else + write(0,*) 'Error on precbld ',info + end if + call psb_erractionrestore(err_act) return @@ -288,7 +421,9 @@ contains call psb_erractionsave(err_act) info = psb_success_ - + + if (allocated(prec%dv)) call prec%dv%free(info) + call psb_erractionrestore(err_act) return diff --git a/prec/psb_s_nullprec.f90 b/prec/psb_s_nullprec.f90 index dc53ffa54..aa5d4028c 100644 --- a/prec/psb_s_nullprec.f90 +++ b/prec/psb_s_nullprec.f90 @@ -4,7 +4,8 @@ module psb_s_nullprec type, extends(psb_s_base_prec_type) :: psb_s_null_prec_type contains - procedure, pass(prec) :: apply => psb_s_null_apply + procedure, pass(prec) :: s_apply_v => psb_s_null_apply_vect + procedure, pass(prec) :: s_apply => psb_s_null_apply procedure, pass(prec) :: precbld => psb_s_null_precbld procedure, pass(prec) :: precinit => psb_s_null_precinit procedure, pass(prec) :: precseti => psb_s_null_precseti @@ -17,11 +18,65 @@ module psb_s_nullprec private :: psb_s_null_apply, psb_s_null_precbld, psb_s_null_precseti,& & psb_s_null_precsetr, psb_s_null_precsetc, psb_s_null_sizeof,& - & psb_s_null_precinit, psb_s_null_precfree, psb_s_null_precdescr + & psb_s_null_precinit, psb_s_null_precfree, psb_s_null_precdescr, & + & psb_s_null_apply_vect contains + subroutine psb_s_null_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) + use psb_base_mod + type(psb_desc_type),intent(in) :: desc_data + class(psb_s_null_prec_type), intent(inout) :: prec + type(psb_s_vect_type),intent(inout) :: x + real(psb_spk_),intent(in) :: alpha, beta + type(psb_s_vect_type),intent(inout) :: y + integer, intent(out) :: info + character(len=1), optional :: trans + real(psb_spk_),intent(inout), optional, target :: work(:) + Integer :: err_act, nrow + character(len=20) :: name='d_null_prec_apply' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = psb_success_ + + nrow = desc_data%get_local_rows() + if (x%get_nrows() < nrow) then + info = 36 + call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/)) + goto 9999 + end if + if (y%get_nrows() < nrow) then + info = 36 + call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/)) + goto 9999 + end if + + call psb_geaxpby(alpha,x,beta,y,desc_data,info) + if (info /= psb_success_ ) then + info = psb_err_from_subroutine_ + call psb_errpush(infoi,name,a_err="psb_geaxpby") + 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 psb_s_null_apply_vect + subroutine psb_s_null_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) use psb_base_mod type(psb_desc_type),intent(in) :: desc_data @@ -38,7 +93,6 @@ contains call psb_erractionsave(err_act) ! - ! Or should it be the NULL preonditioner??? ! info = psb_success_ @@ -102,7 +156,7 @@ contains return end subroutine psb_s_null_precinit - subroutine psb_s_null_precbld(a,desc_a,prec,info,upd,mold,afmt) + subroutine psb_s_null_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold) use psb_base_mod Implicit None @@ -113,7 +167,8 @@ contains integer, intent(out) :: info character, intent(in), optional :: upd character(len=*), intent(in), optional :: afmt - class(psb_s_base_sparse_mat), intent(in), optional :: mold + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold Integer :: err_act, nrow character(len=20) :: name='s_null_precbld' diff --git a/prec/psb_s_prec_type.f90 b/prec/psb_s_prec_type.f90 index 45227bd3c..a0818f250 100644 --- a/prec/psb_s_prec_type.f90 +++ b/prec/psb_s_prec_type.f90 @@ -47,12 +47,14 @@ module psb_s_prec_type type psb_sprec_type class(psb_s_base_prec_type), allocatable :: prec contains + procedure, pass(prec) :: s_apply1_vect + procedure, pass(prec) :: s_apply2_vect procedure, pass(prec) :: s_apply2v procedure, pass(prec) :: s_apply1v - generic, public :: apply => s_apply2v, s_apply1v + generic, public :: apply => s_apply2v, s_apply1v,& + & s_apply1_vect, s_apply2_vect end type psb_sprec_type - interface psb_precfree module procedure psb_s_precfree end interface @@ -62,18 +64,19 @@ module psb_s_prec_type end interface interface psb_precdescr - module procedure psb_sfile_prec_descr + module procedure psb_sfile_prec_descr + end interface + + interface psb_precdump + module procedure psb_s_prec_dump end interface interface psb_sizeof module procedure psb_sprec_sizeof end interface - - contains - subroutine psb_sfile_prec_descr(p,iout) use psb_base_mod type(psb_sprec_type), intent(in) :: p @@ -95,12 +98,33 @@ contains end subroutine psb_sfile_prec_descr + subroutine psb_s_prec_dump(prec,info,prefix,head) + use psb_base_mod + implicit none + type(psb_sprec_type), intent(in) :: prec + integer, intent(out) :: info + character(len=*), intent(in), optional :: prefix,head + ! len of prefix_ + + info = 0 + + if (.not.allocated(prec%prec)) then + info = -1 + write(psb_err_unit,*) 'Trying to dump a non-built preconditioner' + return + end if + + call prec%prec%dump(info,prefix,head) + + + end subroutine psb_s_prec_dump + subroutine psb_s_precfree(p,info) use psb_base_mod type(psb_sprec_type), intent(inout) :: p integer, intent(out) :: info - integer :: me, err_act,i + integer :: me, err_act,i character(len=20) :: name if(psb_get_errstatus() /= 0) return info=psb_success_ @@ -125,7 +149,6 @@ contains return end if return - end subroutine psb_s_precfree subroutine psb_nullify_sprec(p) @@ -147,14 +170,15 @@ contains end function psb_sprec_sizeof - subroutine s_apply2v(prec,x,y,desc_data,info,trans,work) + + subroutine s_apply2_vect(prec,x,y,desc_data,info,trans,work) use psb_base_mod - type(psb_desc_type),intent(in) :: desc_data - class(psb_sprec_type), intent(in) :: prec - real(psb_spk_),intent(inout) :: x(:) - real(psb_spk_),intent(inout) :: y(:) - integer, intent(out) :: info - character(len=1), optional :: trans + type(psb_desc_type),intent(in) :: desc_data + class(psb_sprec_type), intent(inout) :: prec + type(psb_s_vect_type),intent(inout) :: x + type(psb_s_vect_type),intent(inout) :: y + integer, intent(out) :: info + character(len=1), optional :: trans real(psb_spk_),intent(inout), optional, target :: work(:) character :: trans_ @@ -170,7 +194,7 @@ contains call psb_info(ictxt, me, np) if (present(trans)) then - trans_=trans + trans_=psb_toupper(trans) else trans_='N' end if @@ -192,7 +216,10 @@ contains call psb_errpush(info,name,a_err="preconditioner") goto 9999 end if - call prec%prec%apply(sone,x,szero,y,desc_data,info,trans_,work=work_) + + call prec%prec%apply(sone,x,szero,y,desc_data,info,& + & trans=trans_,work=work_) + if (present(work)) then else deallocate(work_,stat=info) @@ -206,6 +233,152 @@ contains 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 s_apply2_vect + + + subroutine s_apply1_vect(prec,x,desc_data,info,trans,work) + use psb_base_mod + type(psb_desc_type),intent(in) :: desc_data + class(psb_sprec_type), intent(inout) :: prec + type(psb_s_vect_type),intent(inout) :: x + integer, intent(out) :: info + character(len=1), optional :: trans + real(psb_spk_),intent(inout), optional, target :: work(:) + + type(psb_s_vect_type) :: ww + character :: trans_ + real(psb_spk_), pointer :: work_(:) + integer :: ictxt,np,me,err_act + character(len=20) :: name + + name='s_apply1v' + info = psb_success_ + call psb_erractionsave(err_act) + + ictxt = desc_data%get_context() + call psb_info(ictxt, me, np) + + if (present(trans)) then + trans_=psb_toupper(trans) + else + trans_='N' + end if + + if (present(work)) then + work_ => work + else + allocate(work_(4*desc_data%get_local_cols()),stat=info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='Allocate') + goto 9999 + end if + + end if + + if (.not.allocated(prec%prec)) then + info = 1124 + call psb_errpush(info,name,a_err="preconditioner") + goto 9999 + end if + + call psb_geall(ww,desc_data,info) + if (info == 0) call psb_geasb(ww,desc_data,info,mold=x%v) + if (info == 0) call prec%prec%apply(sone,x,szero,ww,desc_data,info,& + & trans=trans_,work=work_) + if (info == 0) call psb_geaxpby(sone,ww,szero,x,desc_data,info) + + if (present(work)) then + else + deallocate(work_,stat=info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='DeAllocate') + goto 9999 + end if + 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 s_apply1_vect + + subroutine s_apply2v(prec,x,y,desc_data,info,trans,work) + use psb_base_mod + type(psb_desc_type),intent(in) :: desc_data + class(psb_sprec_type), intent(in) :: prec + real(psb_spk_),intent(inout) :: x(:) + real(psb_spk_),intent(inout) :: y(:) + integer, intent(out) :: info + character(len=1), optional :: trans + real(psb_spk_),intent(inout), optional, target :: work(:) + + character :: trans_ + real(psb_spk_), pointer :: work_(:) + integer :: ictxt,np,me,err_act + character(len=20) :: name + + name='s_apply2v' + info = psb_success_ + call psb_erractionsave(err_act) + + ictxt = desc_data%get_context() + call psb_info(ictxt, me, np) + + if (present(trans)) then + trans_=trans + else + trans_='N' + end if + + if (present(work)) then + work_ => work + else + allocate(work_(4*desc_data%get_local_cols()),stat=info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='Allocate') + goto 9999 + end if + + end if + + if (.not.allocated(prec%prec)) then + info = 1124 + call psb_errpush(info,name,a_err="preconditioner") + goto 9999 + end if + call prec%prec%apply(sone,x,szero,y,desc_data,info,& + & trans=trans_,work=work_) + if (present(work)) then + else + deallocate(work_,stat=info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='DeAllocate') + goto 9999 + end if + end if + + call psb_erractionrestore(err_act) + return + 9999 continue call psb_erractionrestore(err_act) if (err_act == psb_act_abort_) then @@ -231,8 +404,8 @@ contains name='s_apply1v' info = psb_success_ call psb_erractionsave(err_act) - - + + ictxt=desc_data%get_context() call psb_info(ictxt, me, np) if (present(trans)) then @@ -240,7 +413,7 @@ contains else trans_='N' end if - + if (.not.allocated(prec%prec)) then info = 1124 call psb_errpush(info,name,a_err="preconditioner") @@ -252,7 +425,8 @@ contains call psb_errpush(info,name,a_err='Allocate') goto 9999 end if - call prec%prec%apply(sone,x,szero,ww,desc_data,info,trans_,work=w1) + call prec%prec%apply(sone,x,szero,ww,desc_data,info,& + & trans=trans_,work=w1) if(info /= psb_success_) goto 9999 x(:) = ww(:) deallocate(ww,W1,stat=info) @@ -262,7 +436,7 @@ contains goto 9999 end if - + call psb_erractionrestore(err_act) return @@ -274,7 +448,7 @@ contains return end if return - + end subroutine s_apply1v end module psb_s_prec_type diff --git a/prec/psb_sprecbld.f90 b/prec/psb_sprecbld.f90 index ed51bf800..810fdd19d 100644 --- a/prec/psb_sprecbld.f90 +++ b/prec/psb_sprecbld.f90 @@ -29,7 +29,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine psb_sprecbld(a,desc_a,p,info,upd,mold,afmt) +subroutine psb_sprecbld(a,desc_a,p,info,upd,amold,afmt,vmold) use psb_base_mod use psb_prec_mod, psb_protect_name => psb_sprecbld @@ -41,7 +41,8 @@ subroutine psb_sprecbld(a,desc_a,p,info,upd,mold,afmt) integer, intent(out) :: info character, intent(in), optional :: upd character(len=*), intent(in), optional :: afmt - class(psb_s_base_sparse_mat), intent(in), optional :: mold + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold ! Local scalars Integer :: err, n_row, n_col,ictxt,& @@ -79,7 +80,8 @@ subroutine psb_sprecbld(a,desc_a,p,info,upd,mold,afmt) goto 9999 end if - call p%prec%precbld(a,desc_a,info,upd=upd,afmt=afmt,mold=mold) + call p%prec%precbld(a,desc_a,info,upd=upd,& + & afmt=afmt,amold=amold,vmold=vmold) if (info /= psb_success_) goto 9999 diff --git a/prec/psb_z_base_prec_mod.f90 b/prec/psb_z_base_prec_mod.f90 index a516aab86..2a7866d0e 100644 --- a/prec/psb_z_base_prec_mod.f90 +++ b/prec/psb_z_base_prec_mod.f90 @@ -39,13 +39,18 @@ module psb_z_base_prec_mod use psb_base_mod, only : psb_dpk_, psb_spk_, psb_long_int_k_,& & psb_desc_type, psb_sizeof, psb_free, psb_cdfree,& & psb_erractionsave, psb_erractionrestore, psb_error, psb_get_errstatus,& - & psb_zspmat_type - + & psb_zspmat_type, psb_z_base_vect, psb_z_vect_type + use psb_prec_const_mod type psb_z_base_prec_type + integer :: ictxt contains - procedure, pass(prec) :: apply => psb_z_base_apply + procedure, pass(prec) :: set_ctxt => psb_z_base_set_ctxt + procedure, pass(prec) :: get_ctxt => psb_z_base_get_ctxt + procedure, pass(prec) :: z_apply_v => psb_z_base_apply_vect + procedure, pass(prec) :: z_apply => psb_z_base_apply + generic, public :: apply => z_apply, z_apply_v procedure, pass(prec) :: precbld => psb_z_base_precbld procedure, pass(prec) :: precseti => psb_z_base_precseti procedure, pass(prec) :: precsetr => psb_z_base_precsetr @@ -55,15 +60,52 @@ module psb_z_base_prec_mod procedure, pass(prec) :: precinit => psb_z_base_precinit procedure, pass(prec) :: precfree => psb_z_base_precfree procedure, pass(prec) :: precdescr => psb_z_base_precdescr + procedure, pass(prec) :: dump => psb_z_base_precdump end type psb_z_base_prec_type private :: psb_z_base_apply, psb_z_base_precbld, psb_z_base_precseti,& & psb_z_base_precsetr, psb_z_base_precsetc, psb_z_base_sizeof,& - & psb_z_base_precinit, psb_z_base_precfree, psb_z_base_precdescr + & psb_z_base_precinit, psb_z_base_precfree, psb_z_base_precdescr,& + & psb_z_base_precdump, psb_z_base_set_ctxt, psb_z_base_get_ctxt, & + & psb_z_base_apply_vect - contains - + + subroutine psb_z_base_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) + use psb_base_mod + type(psb_desc_type),intent(in) :: desc_data + class(psb_z_base_prec_type), intent(inout) :: prec + complex(psb_dpk_),intent(in) :: alpha, beta + type(psb_z_vect_type),intent(inout) :: x + type(psb_z_vect_type),intent(inout) :: y + integer, intent(out) :: info + character(len=1), optional :: trans + complex(psb_dpk_),intent(inout), optional, target :: work(:) + Integer :: err_act, nrow + character(len=20) :: name='d_base_prec_apply' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + 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 psb_z_base_apply_vect subroutine psb_z_base_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) use psb_base_mod @@ -133,7 +175,7 @@ contains return end subroutine psb_z_base_precinit - subroutine psb_z_base_precbld(a,desc_a,prec,info,upd,mold,afmt) + subroutine psb_z_base_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold) use psb_base_mod Implicit None @@ -144,7 +186,8 @@ contains integer, intent(out) :: info character, intent(in), optional :: upd character(len=*), intent(in), optional :: afmt - class(psb_z_base_sparse_mat), intent(in), optional :: mold + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold Integer :: err_act, nrow character(len=20) :: name='z_base_precbld' @@ -341,6 +384,47 @@ contains end subroutine psb_z_base_precdescr + subroutine psb_z_base_precdump(prec,info,prefix,head) + use psb_base_mod + implicit none + class(psb_z_base_prec_type), intent(in) :: prec + integer, intent(out) :: info + character(len=*), intent(in), optional :: prefix,head + Integer :: err_act, nrow + character(len=20) :: name='d_base_precdump' + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the NULL preonditioner??? + ! + info = 700 + call psb_errpush(info,name) + 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 psb_z_base_precdump + + subroutine psb_z_base_set_ctxt(prec,ictxt) + use psb_base_mod + implicit none + class(psb_z_base_prec_type), intent(inout) :: prec + integer, intent(in) :: ictxt + + prec%ictxt = ictxt + + end subroutine psb_z_base_set_ctxt function psb_z_base_sizeof(prec) result(val) use psb_base_mod @@ -351,4 +435,13 @@ contains return end function psb_z_base_sizeof + function psb_z_base_get_ctxt(prec) result(val) + use psb_base_mod + class(psb_z_base_prec_type), intent(in) :: prec + integer :: val + + val = prec%ictxt + return + end function psb_z_base_get_ctxt + end module psb_z_base_prec_mod diff --git a/prec/psb_z_bjacprec.f90 b/prec/psb_z_bjacprec.f90 index 7881ddd20..32ae60394 100644 --- a/prec/psb_z_bjacprec.f90 +++ b/prec/psb_z_bjacprec.f90 @@ -6,8 +6,10 @@ module psb_z_bjacprec integer, allocatable :: iprcparm(:) type(psb_zspmat_type), allocatable :: av(:) complex(psb_dpk_), allocatable :: d(:) + type(psb_z_vect_type), allocatable :: dv contains - procedure, pass(prec) :: apply => psb_z_bjac_apply + procedure, pass(prec) :: z_apply_v => psb_z_bjac_apply_vect + procedure, pass(prec) :: z_apply => psb_z_bjac_apply procedure, pass(prec) :: precbld => psb_z_bjac_precbld procedure, pass(prec) :: precinit => psb_z_bjac_precinit procedure, pass(prec) :: precseti => psb_z_bjac_precseti @@ -15,13 +17,15 @@ module psb_z_bjacprec procedure, pass(prec) :: precsetc => psb_z_bjac_precsetc procedure, pass(prec) :: precfree => psb_z_bjac_precfree procedure, pass(prec) :: precdescr => psb_z_bjac_precdescr + procedure, pass(prec) :: dump => psb_z_bjac_dump procedure, pass(prec) :: sizeof => psb_z_bjac_sizeof end type psb_z_bjac_prec_type private :: psb_z_bjac_apply, psb_z_bjac_precbld, psb_z_bjac_precseti,& & psb_z_bjac_precsetr, psb_z_bjac_precsetc, psb_z_bjac_sizeof,& - & psb_z_bjac_precinit, psb_z_bjac_precfree, psb_z_bjac_precdescr - + & psb_z_bjac_precinit, psb_z_bjac_precfree, psb_z_bjac_precdescr,& + & psb_z_bjac_dump, psb_z_bjac_apply_vect + character(len=15), parameter, private :: & & fact_names(0:2)=(/'None ','ILU(n) ',& @@ -29,6 +33,154 @@ module psb_z_bjacprec contains + subroutine psb_z_bjac_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) + use psb_base_mod + type(psb_desc_type),intent(in) :: desc_data + class(psb_z_bjac_prec_type), intent(inout) :: prec + complex(psb_dpk_),intent(in) :: alpha,beta + type(psb_z_vect_type),intent(inout) :: x + type(psb_z_vect_type),intent(inout) :: y + integer, intent(out) :: info + character(len=1), optional :: trans + complex(psb_dpk_),intent(inout), optional, target :: work(:) + + ! Local variables + integer :: n_row,n_col + complex(psb_dpk_), pointer :: ww(:), aux(:) + type(psb_z_vect_type) :: wv + integer :: ictxt,np,me, err_act, int_err(5) + integer :: debug_level, debug_unit + character :: trans_ + character(len=20) :: name='d_bjac_prec_apply' + character(len=20) :: ch_err + + info = psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + ictxt = desc_data%get_context() + call psb_info(ictxt, me, np) + + + trans_ = psb_toupper(trans) + select case(trans_) + case('N','T','C') + ! Ok + case default + call psb_errpush(psb_err_iarg_invalid_i_,name) + goto 9999 + end select + + + n_row = desc_data%get_local_rows() + n_col = desc_data%get_local_cols() + + if (x%get_nrows() < n_row) then + info = 36 + call psb_errpush(info,name,i_err=(/2,n_row,0,0,0/)) + goto 9999 + end if + if (y%get_nrows() < n_row) then + info = 36 + call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/)) + goto 9999 + end if + if (.not.allocated(prec%d)) then + info = 1124 + call psb_errpush(info,name,a_err="preconditioner: D") + goto 9999 + end if + if (size(prec%d) < n_row) then + info = 1124 + call psb_errpush(info,name,a_err="preconditioner: D") + goto 9999 + end if + + + if (n_col <= size(work)) then + ww => work(1:n_col) + if ((4*n_col+n_col) <= size(work)) then + aux => work(n_col+1:) + else + allocate(aux(4*n_col),stat=info) + + endif + else + allocate(ww(n_col),aux(4*n_col),stat=info) + endif + if (info == psb_success_) allocate(wv%v,mold=x%v) + + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') + goto 9999 + end if + call wv%bld(n_col) + + select case(prec%iprcparm(psb_f_type_)) + case(psb_f_ilu_n_) + + select case(trans_) + case('N') + call psb_spsm(zone,prec%av(psb_l_pr_),x,zzero,wv,desc_data,info,& + & trans=trans_,scale='L',diag=prec%dv,choice=psb_none_,work=aux) + if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_u_pr_),wv,& + & beta,y,desc_data,info,& + & trans=trans_,scale='U',choice=psb_none_, work=aux) + + case('T') + call psb_spsm(zone,prec%av(psb_u_pr_),x,zzero,wv,desc_data,info,& + & trans=trans_,scale='L',diag=prec%dv,choice=psb_none_, work=aux) + if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_l_pr_),wv,& + & beta,y,desc_data,info,& + & trans=trans_,scale='U',choice=psb_none_,work=aux) + + case('C') + write(0,*) 'WARNING: Conjguate case not fixed yet' + call psb_spsm(zone,prec%av(psb_u_pr_),x,zzero,wv,desc_data,info,& + & trans=trans_,scale='L',diag=prec%dv,choice=psb_none_, work=aux) + if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_l_pr_),wv,& + & beta,y,desc_data,info,& + & trans=trans_,scale='U',choice=psb_none_,work=aux) + + end select + if (info /= psb_success_) then + ch_err="psb_spsm" + goto 9999 + end if + + + case default + info = psb_err_internal_error_ + call psb_errpush(info,name,a_err='Invalid factorization') + goto 9999 + end select + +!!$ call psb_halo(y,desc_data,info,data=psb_comm_mov_) + + if (n_col <= size(work)) then + if ((4*n_col+n_col) <= size(work)) then + else + deallocate(aux) + endif + else + deallocate(ww,aux) + endif + + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_errpush(info,name,i_err=int_err,a_err=ch_err) + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + + + end subroutine psb_z_bjac_apply_vect subroutine psb_z_bjac_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) use psb_base_mod @@ -47,7 +199,7 @@ contains integer :: ictxt,np,me, err_act, int_err(5) integer :: debug_level, debug_unit character :: trans_ - character(len=20) :: name='z_bjac_prec_apply' + character(len=20) :: name='c_bjac_prec_apply' character(len=20) :: ch_err info = psb_success_ @@ -81,16 +233,16 @@ contains call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/)) goto 9999 end if - if (.not.allocated(prec%d)) then - info = 1124 - call psb_errpush(info,name,a_err="preconditioner: D") - goto 9999 - end if - if (size(prec%d) < n_row) then - info = 1124 - call psb_errpush(info,name,a_err="preconditioner: D") - goto 9999 - end if +!!$ if (.not.allocated(prec%d)) then +!!$ info = 1124 +!!$ call psb_errpush(info,name,a_err="preconditioner: D") +!!$ goto 9999 +!!$ end if +!!$ if (size(prec%d) < n_row) then +!!$ info = 1124 +!!$ call psb_errpush(info,name,a_err="preconditioner: D") +!!$ goto 9999 +!!$ end if if (n_col <= size(work)) then @@ -120,21 +272,24 @@ contains select case(trans_) case('N') call psb_spsm(zone,prec%av(psb_l_pr_),x,zzero,ww,desc_data,info,& - & trans=trans_,scale='L',diag=prec%d,choice=psb_none_,work=aux) - if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_u_pr_),ww,beta,y,desc_data,info,& + & trans=trans_,scale='L',diag=prec%dv%v%v,choice=psb_none_,work=aux) + if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_u_pr_),ww,& + & beta,y,desc_data,info,& & trans=trans_,scale='U',choice=psb_none_, work=aux) case('T') call psb_spsm(zone,prec%av(psb_u_pr_),x,zzero,ww,desc_data,info,& - & trans=trans_,scale='L',diag=prec%d,choice=psb_none_, work=aux) - if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_l_pr_),ww,beta,y,desc_data,info,& - & trans=trans_,scale='U',choice=psb_none_,work=aux) - + & trans=trans_,scale='L',diag=prec%dv%v%v,choice=psb_none_, work=aux) + if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_l_pr_),ww,& + & beta,y,desc_data,info,& + & trans=trans_,scale='U',choice=psb_none_,work=aux) + case('C') call psb_spsm(zone,prec%av(psb_u_pr_),x,zzero,ww,desc_data,info,& - & trans=trans_,scale='L',diag=conjg(prec%d),choice=psb_none_, work=aux) - if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_l_pr_),ww,beta,y,desc_data,info,& - & trans=trans_,scale='U',choice=psb_none_,work=aux) + & trans=trans_,scale='L',diag=conjg(prec%dv%v%v),choice=psb_none_, work=aux) + if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_l_pr_),ww,& + & beta,y,desc_data,info,& + & trans=trans_,scale='U',choice=psb_none_,work=aux) end select if (info /= psb_success_) then @@ -215,7 +370,7 @@ contains end subroutine psb_z_bjac_precinit - subroutine psb_z_bjac_precbld(a,desc_a,prec,info,upd,mold,afmt) + subroutine psb_z_bjac_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold) use psb_base_mod use psb_prec_mod, only : psb_ilu_fct @@ -227,13 +382,15 @@ contains integer, intent(out) :: info character, intent(in), optional :: upd character(len=*), intent(in), optional :: afmt - class(psb_z_base_sparse_mat), intent(in), optional :: mold + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold ! .. Local Scalars .. integer :: i, m integer :: int_err(5) character :: trans, unitd type(psb_z_csr_sparse_mat), allocatable :: lf, uf + complex(psb_dpk_), allocatable :: dd(:) integer nztota, err_act, n_row, nrow_a,n_col, nhalo integer :: ictxt,np,me character(len=20) :: name='z_bjac_precbld' @@ -248,6 +405,8 @@ contains ictxt=desc_a%get_context() call psb_info(ictxt, me, np) + call prec%set_ctxt(ictxt) + m = a%get_nrows() if (m < 0) then info = psb_err_iarg_neg_ @@ -297,21 +456,24 @@ contains goto 9999 end if - if (allocated(prec%d)) then - if (size(prec%d) < n_row) then - deallocate(prec%d) - endif - endif - if (.not.allocated(prec%d)) then - allocate(prec%d(n_row),stat=info) - if (info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') - goto 9999 + allocate(dd(n_row),stat=info) + if (info == psb_success_) then + allocate(prec%dv, stat=info) + if (info == 0) then + if (present(vmold)) then + allocate(prec%dv%v,mold=vmold,stat=info) + else + allocate(psb_z_base_vect_type :: prec%dv%v,stat=info) + end if end if - + end if + + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') + goto 9999 endif ! This is where we have no renumbering, thus no need - call psb_ilu_fct(a,lf,uf,prec%d,info) + call psb_ilu_fct(a,lf,uf,dd,info) if(info == psb_success_) then call prec%av(psb_l_pr_)%mv_from(lf) @@ -320,13 +482,15 @@ contains call prec%av(psb_u_pr_)%set_asb() call prec%av(psb_l_pr_)%trim() call prec%av(psb_u_pr_)%trim() + call prec%dv%bld(dd) + call move_alloc(dd,prec%d) else info=psb_err_from_subroutine_ ch_err='psb_ilu_fct' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - + case(psb_f_none_) info=psb_err_from_subroutine_ ch_err='Inconsistent prec psb_f_none_' @@ -340,15 +504,14 @@ contains goto 9999 end select - if (present(mold)) then - call prec%av(psb_l_pr_)%cscnv(info,mold=mold) - call prec%av(psb_u_pr_)%cscnv(info,mold=mold) + if (present(amold)) then + call prec%av(psb_l_pr_)%cscnv(info,mold=amold) + call prec%av(psb_u_pr_)%cscnv(info,mold=amold) else if (present(afmt)) then call prec%av(psb_l_pr_)%cscnv(info,type=afmt) call prec%av(psb_u_pr_)%cscnv(info,type=afmt) end if - call psb_erractionrestore(err_act) return @@ -386,15 +549,18 @@ contains select case(what) case (psb_f_type_) if (prec%iprcparm(psb_p_type_) /= psb_bjac_) then - write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',prec%iprcparm(psb_p_type_),& + write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',& + & prec%iprcparm(psb_p_type_),& & 'ignoring user specification' return endif prec%iprcparm(psb_f_type_) = val case (psb_ilu_fill_in_) - if ((prec%iprcparm(psb_p_type_) /= psb_bjac_).or.(prec%iprcparm(psb_f_type_) /= psb_f_ilu_n_)) then - write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',prec%iprcparm(psb_p_type_),& + if ((prec%iprcparm(psb_p_type_) /= psb_bjac_).or.& + & (prec%iprcparm(psb_f_type_) /= psb_f_ilu_n_)) then + write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',& + & prec%iprcparm(psb_p_type_),& & 'ignoring user specification' return endif @@ -496,6 +662,10 @@ contains if (allocated(prec%d)) then deallocate(prec%d,stat=info) end if + if (allocated(prec%dv)) then + call prec%dv%free(info) + if (info == 0) deallocate(prec%dv,stat=info) + end if call psb_erractionrestore(err_act) return @@ -558,6 +728,46 @@ contains end subroutine psb_z_bjac_precdescr + + subroutine psb_z_bjac_dump(prec,info,prefix,head) + use psb_base_mod + implicit none + class(psb_z_bjac_prec_type), intent(in) :: prec + integer, intent(out) :: info + character(len=*), intent(in), optional :: prefix,head + integer :: i, j, il1, iln, lname, lev + integer :: ictxt,iam, np + character(len=80) :: prefix_ + character(len=120) :: fname ! len should be at least 20 more than + + ! len of prefix_ + + info = 0 + ictxt = prec%get_ctxt() + call psb_info(ictxt,iam,np) + + if (present(prefix)) then + prefix_ = trim(prefix(1:min(len(prefix),len(prefix_)))) + else + prefix_ = "dump_fact_d" + end if + + lname = len_trim(prefix_) + fname = trim(prefix_) + write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam + lname = lname + 5 + write(fname(lname+1:),'(a)')'_lower.mtx' + if (prec%av(psb_l_pr_)%is_asb()) & + & call prec%av(psb_l_pr_)%print(fname,head=head) + write(fname(lname+1:),'(a,a)')'_diag.mtx' + if (allocated(prec%d)) & + & call psb_geprt(fname,prec%d,head=head) + write(fname(lname+1:),'(a)')'_upper.mtx' + if (prec%av(psb_u_pr_)%is_asb()) & + & call prec%av(psb_u_pr_)%print(fname,head=head) + + end subroutine psb_z_bjac_dump + function psb_z_bjac_sizeof(prec) result(val) use psb_base_mod class(psb_z_bjac_prec_type), intent(in) :: prec diff --git a/prec/psb_z_diagprec.f90 b/prec/psb_z_diagprec.f90 index e242102d0..c254aee09 100644 --- a/prec/psb_z_diagprec.f90 +++ b/prec/psb_z_diagprec.f90 @@ -3,9 +3,11 @@ module psb_z_diagprec use psb_z_base_prec_mod type, extends(psb_z_base_prec_type) :: psb_z_diag_prec_type - complex(psb_dpk_), allocatable :: d(:) + complex(psb_dpk_), allocatable :: d(:) + type(psb_z_vect_type), allocatable :: dv contains - procedure, pass(prec) :: apply => psb_z_diag_apply + procedure, pass(prec) :: z_apply_v => psb_z_diag_apply_vect + procedure, pass(prec) :: z_apply => psb_z_diag_apply procedure, pass(prec) :: precbld => psb_z_diag_precbld procedure, pass(prec) :: precinit => psb_z_diag_precinit procedure, pass(prec) :: precseti => psb_z_diag_precseti @@ -18,12 +20,94 @@ module psb_z_diagprec private :: psb_z_diag_apply, psb_z_diag_precbld, psb_z_diag_precseti,& & psb_z_diag_precsetr, psb_z_diag_precsetc, psb_z_diag_sizeof,& - & psb_z_diag_precinit, psb_z_diag_precfree, psb_z_diag_precdescr + & psb_z_diag_precinit, psb_z_diag_precfree, psb_z_diag_precdescr,& + & psb_z_diag_apply_vect contains + subroutine psb_z_diag_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) + use psb_base_mod + type(psb_desc_type),intent(in) :: desc_data + class(psb_z_diag_prec_type), intent(inout) :: prec + type(psb_z_vect_type),intent(inout) :: x + complex(psb_dpk_),intent(in) :: alpha, beta + type(psb_z_vect_type),intent(inout) :: y + integer, intent(out) :: info + character(len=1), optional :: trans + complex(psb_dpk_),intent(inout), optional, target :: work(:) + Integer :: err_act, nrow + character(len=20) :: name='d_diag_prec_apply' + complex(psb_dpk_), pointer :: ww(:) + class(psb_z_base_vect_type), allocatable :: dw + + call psb_erractionsave(err_act) + + ! + ! This is the base version and we should throw an error. + ! Or should it be the DIAG preonditioner??? + ! + info = psb_success_ + + nrow = desc_data%get_local_rows() + if (x%get_nrows() < nrow) then + info = 36 + call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/)) + goto 9999 + end if + if (y%get_nrows() < nrow) then + info = 36 + call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/)) + goto 9999 + end if + if (.not.allocated(prec%d)) then + info = 1124 + call psb_errpush(info,name,a_err="preconditioner: D") + goto 9999 + end if + if (size(prec%d) < nrow) then + info = 1124 + call psb_errpush(info,name,a_err="preconditioner: D") + goto 9999 + end if + + if (size(work) >= x%get_nrows()) then + ww => work + else + allocate(ww(x%get_nrows()),stat=info) + if (info /= psb_success_) then + call psb_errpush(psb_err_alloc_request_,name,& + & i_err=(/x%get_nrows(),0,0,0,0/),a_err='complex(psb_dpk_)') + goto 9999 + end if + end if + + + call y%mlt(alpha,prec%dv,x,beta,info,conjgx=trans) + + if (size(work) < x%get_nrows()) then + deallocate(ww,stat=info) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='Deallocate') + goto 9999 + end if + 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 psb_z_diag_apply_vect + + subroutine psb_z_diag_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) use psb_base_mod type(psb_desc_type),intent(in) :: desc_data @@ -36,17 +120,12 @@ contains complex(psb_dpk_),intent(inout), optional, target :: work(:) Integer :: err_act, nrow character :: trans_ - character(len=20) :: name='z_diag_prec_apply' + character(len=20) :: name='c_diag_prec_apply' complex(psb_dpk_), pointer :: ww(:) call psb_erractionsave(err_act) - ! - ! This is the base version and we should throw an error. - ! Or should it be the DIAG preonditioner??? - ! info = psb_success_ - nrow = desc_data%get_local_rows() if (size(x) < nrow) then @@ -153,7 +232,7 @@ contains end subroutine psb_z_diag_precinit - subroutine psb_z_diag_precbld(a,desc_a,prec,info,upd,mold,afmt) + subroutine psb_z_diag_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold) use psb_base_mod Implicit None @@ -164,7 +243,8 @@ contains integer, intent(out) :: info character, intent(in), optional :: upd character(len=*), intent(in), optional :: afmt - class(psb_z_base_sparse_mat), intent(in), optional :: mold + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold Integer :: err_act, nrow,i character(len=20) :: name='z_diag_precbld' @@ -200,7 +280,20 @@ contains prec%d(i) = done/prec%d(i) endif end do - + allocate(prec%dv,stat=info) + if (info == 0) then + if (present(vmold)) then + allocate(prec%dv%v,mold=vmold,stat=info) + else + allocate(psb_z_base_vect_type :: prec%dv%v,stat=info) + end if + end if + if (info == 0) then + call prec%dv%bld(prec%d) + else + write(0,*) 'Error on precbld ',info + end if + call psb_erractionrestore(err_act) return @@ -311,6 +404,8 @@ contains call psb_erractionsave(err_act) info = psb_success_ + + if (allocated(prec%dv)) call prec%dv%free(info) call psb_erractionrestore(err_act) return diff --git a/prec/psb_z_nullprec.f90 b/prec/psb_z_nullprec.f90 index 8edbacefe..975aa5221 100644 --- a/prec/psb_z_nullprec.f90 +++ b/prec/psb_z_nullprec.f90 @@ -4,7 +4,8 @@ module psb_z_nullprec type, extends(psb_z_base_prec_type) :: psb_z_null_prec_type contains - procedure, pass(prec) :: apply => psb_z_null_apply + procedure, pass(prec) :: z_apply_v => psb_z_null_apply_vect + procedure, pass(prec) :: z_apply => psb_z_null_apply procedure, pass(prec) :: precbld => psb_z_null_precbld procedure, pass(prec) :: precinit => psb_z_null_precinit procedure, pass(prec) :: precseti => psb_z_null_precseti @@ -17,21 +18,22 @@ module psb_z_nullprec private :: psb_z_null_apply, psb_z_null_precbld, psb_z_null_precseti,& & psb_z_null_precsetr, psb_z_null_precsetc, psb_z_null_sizeof,& - & psb_z_null_precinit, psb_z_null_precfree, psb_z_null_precdescr + & psb_z_null_precinit, psb_z_null_precfree, psb_z_null_precdescr, & + & psb_z_null_apply_vect contains - subroutine psb_z_null_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) + subroutine psb_z_null_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work) use psb_base_mod - type(psb_desc_type),intent(in) :: desc_data - class(psb_z_null_prec_type), intent(in) :: prec - complex(psb_dpk_),intent(inout) :: x(:) + type(psb_desc_type),intent(in) :: desc_data + class(psb_z_null_prec_type), intent(inout) :: prec + type(psb_z_vect_type),intent(inout) :: x complex(psb_dpk_),intent(in) :: alpha, beta - complex(psb_dpk_),intent(inout) :: y(:) - integer, intent(out) :: info - character(len=1), optional :: trans + type(psb_z_vect_type),intent(inout) :: y + integer, intent(out) :: info + character(len=1), optional :: trans complex(psb_dpk_),intent(inout), optional, target :: work(:) Integer :: err_act, nrow character(len=20) :: name='z_null_prec_apply' @@ -44,6 +46,57 @@ contains ! info = psb_success_ + nrow = desc_data%get_local_rows() + if (x%get_nrows() < nrow) then + info = 36 + call psb_errpush(info,name,i_err=(/2,nrow,0,0,0/)) + goto 9999 + end if + if (y%get_nrows() < nrow) then + info = 36 + call psb_errpush(info,name,i_err=(/3,nrow,0,0,0/)) + goto 9999 + end if + + call psb_geaxpby(alpha,x,beta,y,desc_data,info) + if (info /= psb_success_ ) then + info = psb_err_from_subroutine_ + call psb_errpush(infoi,name,a_err="psb_geaxpby") + 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 psb_z_null_apply_vect + + subroutine psb_z_null_apply(alpha,prec,x,beta,y,desc_data,info,trans,work) + use psb_base_mod + type(psb_desc_type),intent(in) :: desc_data + class(psb_z_null_prec_type), intent(in) :: prec + complex(psb_dpk_),intent(inout) :: x(:) + complex(psb_dpk_),intent(in) :: alpha, beta + complex(psb_dpk_),intent(inout) :: y(:) + integer, intent(out) :: info + character(len=1), optional :: trans + complex(psb_dpk_),intent(inout), optional, target :: work(:) + Integer :: err_act, nrow + character(len=20) :: name='z_null_prec_apply' + + call psb_erractionsave(err_act) + + ! + ! + info = psb_success_ + nrow = desc_data%get_local_rows() if (size(x) < nrow) then info = 36 @@ -104,7 +157,7 @@ contains return end subroutine psb_z_null_precinit - subroutine psb_z_null_precbld(a,desc_a,prec,info,upd,mold,afmt) + subroutine psb_z_null_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold) use psb_base_mod Implicit None @@ -115,7 +168,8 @@ contains integer, intent(out) :: info character, intent(in), optional :: upd character(len=*), intent(in), optional :: afmt - class(psb_z_base_sparse_mat), intent(in), optional :: mold + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold Integer :: err_act, nrow character(len=20) :: name='z_null_precbld' diff --git a/prec/psb_z_prec_type.f90 b/prec/psb_z_prec_type.f90 index f4b8d1cad..cfb519950 100644 --- a/prec/psb_z_prec_type.f90 +++ b/prec/psb_z_prec_type.f90 @@ -47,9 +47,12 @@ module psb_z_prec_type type psb_zprec_type class(psb_z_base_prec_type), allocatable :: prec contains + procedure, pass(prec) :: z_apply1_vect + procedure, pass(prec) :: z_apply2_vect procedure, pass(prec) :: z_apply2v procedure, pass(prec) :: z_apply1v - generic, public :: apply => z_apply2v, z_apply1v + generic, public :: apply => z_apply2v, z_apply1v,& + & z_apply1_vect, z_apply2_vect end type psb_zprec_type interface psb_precfree @@ -64,13 +67,15 @@ module psb_z_prec_type module procedure psb_zfile_prec_descr end interface + interface psb_precdump + module procedure psb_z_prec_dump + end interface + interface psb_sizeof module procedure psb_zprec_sizeof end interface - contains - subroutine psb_zfile_prec_descr(p,iout) use psb_base_mod @@ -93,11 +98,33 @@ contains end subroutine psb_zfile_prec_descr + subroutine psb_z_prec_dump(prec,info,prefix,head) + use psb_base_mod + implicit none + type(psb_zprec_type), intent(in) :: prec + integer, intent(out) :: info + character(len=*), intent(in), optional :: prefix,head + ! len of prefix_ + + info = 0 + + if (.not.allocated(prec%prec)) then + info = -1 + write(psb_err_unit,*) 'Trying to dump a non-built preconditioner' + return + end if + + call prec%prec%dump(info,prefix,head) + + + end subroutine psb_z_prec_dump + + subroutine psb_z_precfree(p,info) use psb_base_mod type(psb_zprec_type), intent(inout) :: p integer, intent(out) :: info - integer :: err_act,i + integer :: me, err_act,i character(len=20) :: name if(psb_get_errstatus() /= 0) return info=psb_success_ @@ -142,7 +169,153 @@ contains end function psb_zprec_sizeof + subroutine z_apply2_vect(prec,x,y,desc_data,info,trans,work) + use psb_base_mod + type(psb_desc_type),intent(in) :: desc_data + class(psb_zprec_type), intent(inout) :: prec + type(psb_z_vect_type),intent(inout) :: x + type(psb_z_vect_type),intent(inout) :: y + integer, intent(out) :: info + character(len=1), optional :: trans + complex(psb_dpk_),intent(inout), optional, target :: work(:) + + character :: trans_ + complex(psb_dpk_), pointer :: work_(:) + integer :: ictxt,np,me,err_act + character(len=20) :: name + + name = 'z_apply2v' + info = psb_success_ + call psb_erractionsave(err_act) + + ictxt = desc_data%get_context() + call psb_info(ictxt, me, np) + + if (present(trans)) then + trans_=psb_toupper(trans) + else + trans_='N' + end if + + if (present(work)) then + work_ => work + else + allocate(work_(4*desc_data%get_local_cols()),stat=info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='Allocate') + goto 9999 + end if + + end if + + if (.not.allocated(prec%prec)) then + info = 1124 + call psb_errpush(info,name,a_err="preconditioner") + goto 9999 + end if + call prec%prec%apply(zone,x,zzero,y,desc_data,info,& + & trans=trans_,work=work_) + + if (present(work)) then + else + deallocate(work_,stat=info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='DeAllocate') + goto 9999 + end if + 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 z_apply2_vect + + subroutine z_apply1_vect(prec,x,desc_data,info,trans,work) + use psb_base_mod + type(psb_desc_type),intent(in) :: desc_data + class(psb_zprec_type), intent(inout) :: prec + type(psb_z_vect_type),intent(inout) :: x + integer, intent(out) :: info + character(len=1), optional :: trans + complex(psb_dpk_),intent(inout), optional, target :: work(:) + + type(psb_z_vect_type) :: ww + character :: trans_ + complex(psb_dpk_), pointer :: work_(:) + integer :: ictxt,np,me,err_act + character(len=20) :: name + + name = 'z_apply1v' + info = psb_success_ + call psb_erractionsave(err_act) + + ictxt = desc_data%get_context() + call psb_info(ictxt, me, np) + + if (present(trans)) then + trans_=psb_toupper(trans) + else + trans_='N' + end if + + if (present(work)) then + work_ => work + else + allocate(work_(4*desc_data%get_local_cols()),stat=info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='Allocate') + goto 9999 + end if + + end if + + if (.not.allocated(prec%prec)) then + info = 1124 + call psb_errpush(info,name,a_err="preconditioner") + goto 9999 + end if + + call psb_geall(ww,desc_data,info) + if (info == 0) call psb_geasb(ww,desc_data,info,mold=x%v) + if (info == 0) call prec%prec%apply(zone,x,zzero,ww,desc_data,info,& + & trans=trans_,work=work_) + if (info == 0) call psb_geaxpby(zone,ww,zzero,x,desc_data,info) + + if (present(work)) then + else + deallocate(work_,stat=info) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='DeAllocate') + goto 9999 + end if + 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 z_apply1_vect + subroutine z_apply2v(prec,x,y,desc_data,info,trans,work) use psb_base_mod type(psb_desc_type),intent(in) :: desc_data diff --git a/prec/psb_zprecbld.f90 b/prec/psb_zprecbld.f90 index 8872ecbf7..689ab0b6b 100644 --- a/prec/psb_zprecbld.f90 +++ b/prec/psb_zprecbld.f90 @@ -29,7 +29,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine psb_zprecbld(a,desc_a,p,info,upd,mold,afmt) +subroutine psb_zprecbld(a,desc_a,p,info,upd,amold,afmt,vmold) use psb_base_mod use psb_prec_mod, psb_protect_name => psb_zprecbld @@ -41,8 +41,8 @@ subroutine psb_zprecbld(a,desc_a,p,info,upd,mold,afmt) integer, intent(out) :: info character, intent(in), optional :: upd character(len=*), intent(in), optional :: afmt - class(psb_z_base_sparse_mat), intent(in), optional :: mold - + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold ! Local scalars Integer :: err, n_row, n_col,ictxt,& @@ -80,7 +80,8 @@ subroutine psb_zprecbld(a,desc_a,p,info,upd,mold,afmt) goto 9999 end if - call p%prec%precbld(a,desc_a,info,upd=upd,afmt=afmt,mold=mold) + call p%prec%precbld(a,desc_a,info,upd=upd,& + & afmt=afmt,amold=amold,vmold=vmold) if (info /= psb_success_) goto 9999 diff --git a/test/fileread/cf_sample.f90 b/test/fileread/cf_sample.f90 index 35dbd3673..baef7b3d6 100644 --- a/test/fileread/cf_sample.f90 +++ b/test/fileread/cf_sample.f90 @@ -48,9 +48,9 @@ program cf_sample ! dense matrices complex(psb_spk_), allocatable, target :: aux_b(:,:), d(:) - complex(psb_spk_), allocatable , save :: b_col(:), x_col(:), r_col(:), & - & x_col_glob(:), r_col_glob(:) + complex(psb_spk_), allocatable , save :: x_col_glob(:), r_col_glob(:) complex(psb_spk_), pointer :: b_col_glob(:) + type(psb_c_vect_type) :: b_col, x_col, r_col ! communications data structure type(psb_desc_type):: desc_a @@ -75,7 +75,8 @@ program cf_sample real(psb_dpk_) :: t1, t2, tprec real(psb_spk_) :: r_amax, b_amax, scale,resmx,resmxp integer :: nrhs, nrow, n_row, dim, nv, ne - integer, allocatable :: ivg(:), ipv(:) + integer, allocatable :: ivg(:), ipv(:), perm(:) + character(len=40) :: fname, fnout call psb_init(ictxt) @@ -138,12 +139,15 @@ program cf_sample m_problem = aux_a%get_nrows() call psb_bcast(ictxt,m_problem) - +!!$ call psb_mat_renum(psb_mat_renum_gps_,aux_a,info,perm) + ! At this point aux_b may still be unallocated if (psb_size(aux_b,dim=1) == m_problem) then ! if any rhs were present, broadcast the first one write(psb_err_unit,'("Ok, got an rhs ")') b_col_glob =>aux_b(:,1) +!!$ call psb_gelp('N',perm(1:m_problem),& +!!$ & b_col_glob(1:m_problem),info) else write(psb_out_unit,'("Generating an rhs...")') write(psb_out_unit,'(" ")') @@ -159,7 +163,9 @@ program cf_sample enddo endif call psb_bcast(ictxt,b_col_glob(1:m_problem)) + else + call psb_bcast(ictxt,m_problem) call psb_realloc(m_problem,1,aux_b,ircode) if (ircode /= 0) then @@ -181,6 +187,7 @@ program cf_sample enddo call psb_matdist(aux_a, a, ictxt, & & desc_a,b_col_glob,b_col,info,fmt=afmt,v=ivg) + else if (ipart == 2) then if (iam == psb_root_) then write(psb_out_unit,'("Partition type: graph")') @@ -194,17 +201,18 @@ program cf_sample call getv_mtpart(ivg) call psb_matdist(aux_a, a, ictxt, & & desc_a,b_col_glob,b_col,info,fmt=afmt,v=ivg) + else if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")') call psb_matdist(aux_a, a, ictxt, & & desc_a,b_col_glob,b_col,info,fmt=afmt,parts=part_block) end if - + call psb_geall(x_col,desc_a,info) - x_col(:) =0.0 + call x_col%set(czero) call psb_geasb(x_col,desc_a,info) call psb_geall(r_col,desc_a,info) - r_col(:) =0.0 + call r_col%set(czero) call psb_geasb(r_col,desc_a,info) t2 = psb_wtime() - t1 diff --git a/test/fileread/df_sample.f90 b/test/fileread/df_sample.f90 index 11d125940..861680767 100644 --- a/test/fileread/df_sample.f90 +++ b/test/fileread/df_sample.f90 @@ -48,9 +48,10 @@ program df_sample ! dense matrices real(psb_dpk_), allocatable, target :: aux_b(:,:), d(:) - real(psb_dpk_), allocatable , save :: b_col(:), x_col(:), r_col(:), & - & x_col_glob(:), r_col_glob(:) + real(psb_dpk_), allocatable , save :: x_col_glob(:), r_col_glob(:) real(psb_dpk_), pointer :: b_col_glob(:) + type(psb_d_vect_type) :: b_col, x_col, r_col + ! communications data structure type(psb_desc_type):: desc_a @@ -75,7 +76,7 @@ program df_sample real(psb_dpk_) :: t1, t2, tprec, r_amax, b_amax,& &scale,resmx,resmxp integer :: nrhs, nrow, n_row, dim, nv, ne - integer, allocatable :: ivg(:), ipv(:) + integer, allocatable :: ivg(:), ipv(:), perm(:) character(len=40) :: fname, fnout @@ -139,12 +140,15 @@ program df_sample m_problem = aux_a%get_nrows() call psb_bcast(ictxt,m_problem) - + call psb_mat_renum(psb_mat_renum_gps_,aux_a,info,perm) + ! At this point aux_b may still be unallocated if (psb_size(aux_b,dim=1) == m_problem) then ! if any rhs were present, broadcast the first one write(psb_err_unit,'("Ok, got an rhs ")') b_col_glob =>aux_b(:,1) + call psb_gelp('N',perm(1:m_problem),& + & b_col_glob(1:m_problem),info) else write(psb_out_unit,'("Generating an rhs...")') write(psb_out_unit,'(" ")') @@ -174,8 +178,6 @@ program df_sample end if - call psb_mat_renum(psb_mat_renum_gps_,aux_a,info) - ! switch over different partition types if (ipart == 0) then call psb_barrier(ictxt) @@ -209,10 +211,10 @@ program df_sample end if call psb_geall(x_col,desc_a,info) - x_col(:) =0.0 + call x_col%set(dzero) call psb_geasb(x_col,desc_a,info) call psb_geall(r_col,desc_a,info) - r_col(:) =0.0 + call r_col%set(dzero) call psb_geasb(r_col,desc_a,info) t2 = psb_wtime() - t1 @@ -258,8 +260,8 @@ program df_sample call psb_amx(ictxt,t2) call psb_geaxpby(done,b_col,dzero,r_col,desc_a,info) call psb_spmm(-done,a,x_col,done,r_col,desc_a,info) - call psb_genrm2s(resmx,r_col,desc_a,info) - call psb_geamaxs(resmxp,r_col,desc_a,info) + resmx = psb_genrm2(r_col,desc_a,info) + resmxp = psb_geamax(r_col,desc_a,info) amatsize = psb_sizeof(a) descsize = psb_sizeof(desc_a) diff --git a/test/fileread/runs/dfs.inp b/test/fileread/runs/dfs.inp index ddfc82414..bc55c5545 100644 --- a/test/fileread/runs/dfs.inp +++ b/test/fileread/runs/dfs.inp @@ -1,6 +1,6 @@ 11 Number of inputs -A_1M_gps.mtx This (and others) from: http://math.nist.gov/MatrixMarket/ or -NONE sherman3_rhs1.mtx http://www.cise.ufl.edu/research/sparse/matrices/index.html +sherman3.mtx This (and others) from: http://math.nist.gov/MatrixMarket/ or +sherman3_b.mtx http://www.cise.ufl.edu/research/sparse/matrices/index.html MM File format: MM: Matrix Market HB: Harwell-Boeing. BICGSTAB Iterative method: BiCGSTAB CGS RGMRES BiCGSTABL BICG CG BJAC Preconditioner NONE DIAG BJAC diff --git a/test/fileread/runs/sfs.inp b/test/fileread/runs/sfs.inp index 36d2ef20f..bd3ba74a1 100644 --- a/test/fileread/runs/sfs.inp +++ b/test/fileread/runs/sfs.inp @@ -1,6 +1,6 @@ 11 Number of inputs -sherman3.mtx This (and others) from: http://math.nist.gov/MatrixMarket/ or -NONE http://www.cise.ufl.edu/research/sparse/matrices/index.html +sherman1.mtx This (and others) from: http://math.nist.gov/MatrixMarket/ or +sherman1_b.mtx http://www.cise.ufl.edu/research/sparse/matrices/index.html MM File format: MM: Matrix Market HB: Harwell-Boeing. BICGSTAB Iterative method: BiCGSTAB CGS RGMRES BiCGSTABL BICG CG BJAC Preconditioner NONE DIAG BJAC diff --git a/test/fileread/sf_sample.f90 b/test/fileread/sf_sample.f90 index 2f84cc5a5..c7ffe1b10 100644 --- a/test/fileread/sf_sample.f90 +++ b/test/fileread/sf_sample.f90 @@ -48,9 +48,10 @@ program sf_sample ! dense matrices real(psb_spk_), allocatable, target :: aux_b(:,:), d(:) - real(psb_spk_), allocatable , save :: b_col(:), x_col(:), r_col(:), & - & x_col_glob(:), r_col_glob(:) + real(psb_spk_), allocatable , save :: x_col_glob(:), r_col_glob(:) real(psb_spk_), pointer :: b_col_glob(:) + type(psb_s_vect_type) :: b_col, x_col, r_col + ! communications data structure type(psb_desc_type):: desc_a @@ -72,10 +73,11 @@ program sf_sample ! other variables integer :: i,info,j,m_problem integer :: internal, m,ii,nnzero - real(psb_spk_) :: t1, t2, tprec, r_amax, b_amax,& - &scale,resmx,resmxp + real(psb_dpk_) :: t1, t2, tprec + real(psb_spk_) :: r_amax, b_amax, scale,resmx,resmxp integer :: nrhs, nrow, n_row, dim, nv, ne - integer, allocatable :: ivg(:), ipv(:) + integer, allocatable :: ivg(:), ipv(:), perm(:) + character(len=40) :: fname, fnout call psb_init(ictxt) @@ -88,7 +90,7 @@ program sf_sample endif - name='df_sample' + name='sf_sample' if(psb_get_errstatus() /= 0) goto 9999 info=psb_success_ call psb_set_errverbosity(2) @@ -138,12 +140,15 @@ program sf_sample m_problem = aux_a%get_nrows() call psb_bcast(ictxt,m_problem) - +!!$ call psb_mat_renum(psb_mat_renum_gps_,aux_a,info,perm) + ! At this point aux_b may still be unallocated if (psb_size(aux_b,dim=1) == m_problem) then ! if any rhs were present, broadcast the first one write(psb_err_unit,'("Ok, got an rhs ")') b_col_glob =>aux_b(:,1) +!!$ call psb_gelp('N',perm(1:m_problem),& +!!$ & b_col_glob(1:m_problem),info) else write(psb_out_unit,'("Generating an rhs...")') write(psb_out_unit,'(" ")') @@ -159,7 +164,9 @@ program sf_sample enddo endif call psb_bcast(ictxt,b_col_glob(1:m_problem)) + else + call psb_bcast(ictxt,m_problem) call psb_realloc(m_problem,1,aux_b,ircode) if (ircode /= 0) then @@ -181,6 +188,7 @@ program sf_sample enddo call psb_matdist(aux_a, a, ictxt, & & desc_a,b_col_glob,b_col,info,fmt=afmt,v=ivg) + else if (ipart == 2) then if (iam == psb_root_) then write(psb_out_unit,'("Partition type: graph")') @@ -194,6 +202,7 @@ program sf_sample call getv_mtpart(ivg) call psb_matdist(aux_a, a, ictxt, & & desc_a,b_col_glob,b_col,info,fmt=afmt,v=ivg) + else if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")') call psb_matdist(aux_a, a, ictxt, & @@ -201,10 +210,10 @@ program sf_sample end if call psb_geall(x_col,desc_a,info) - x_col(:) =0.0 + call x_col%set(szero) call psb_geasb(x_col,desc_a,info) call psb_geall(r_col,desc_a,info) - r_col(:) =0.0 + call r_col%set(szero) call psb_geasb(r_col,desc_a,info) t2 = psb_wtime() - t1 @@ -237,7 +246,7 @@ program sf_sample write(psb_out_unit,'("Preconditioner time: ",es12.5)')tprec write(psb_out_unit,'(" ")') end if - cond = -sone + cond = szero iparm = 0 call psb_barrier(ictxt) t1 = psb_wtime() @@ -250,8 +259,8 @@ program sf_sample call psb_amx(ictxt,t2) call psb_geaxpby(sone,b_col,szero,r_col,desc_a,info) call psb_spmm(-sone,a,x_col,sone,r_col,desc_a,info) - call psb_genrm2s(resmx,r_col,desc_a,info) - call psb_geamaxs(resmxp,r_col,desc_a,info) + resmx = psb_genrm2(r_col,desc_a,info) + resmxp = psb_geamax(r_col,desc_a,info) amatsize = psb_sizeof(a) descsize = psb_sizeof(desc_a) @@ -278,6 +287,7 @@ program sf_sample write(psb_out_unit,'("Storage type for DESC_A : ",a)')& & desc_a%indxmap%get_fmt() end if +!!$ call psb_precdump(prec,info,prefix=trim(mtrx_file)//'_') allocate(x_col_glob(m_problem),r_col_glob(m_problem),stat=ierr) if (ierr /= 0) then diff --git a/test/fileread/zf_sample.f90 b/test/fileread/zf_sample.f90 index 802a38719..7cf848785 100644 --- a/test/fileread/zf_sample.f90 +++ b/test/fileread/zf_sample.f90 @@ -48,9 +48,9 @@ program zf_sample ! dense matrices complex(psb_dpk_), allocatable, target :: aux_b(:,:), d(:) - complex(psb_dpk_), allocatable , save :: b_col(:), x_col(:), r_col(:), & - & x_col_glob(:), r_col_glob(:) + complex(psb_dpk_), allocatable , save :: x_col_glob(:), r_col_glob(:) complex(psb_dpk_), pointer :: b_col_glob(:) + type(psb_z_vect_type) :: b_col, x_col, r_col ! communications data structure type(psb_desc_type):: desc_a @@ -72,10 +72,11 @@ program zf_sample ! other variables integer :: i,info,j,m_problem integer :: internal, m,ii,nnzero - real(psb_dpk_) :: t1, t2, tprec, r_amax, b_amax,& - &scale,resmx,resmxp + real(psb_dpk_) :: t1, t2, tprec + real(psb_dpk_) :: r_amax, b_amax, scale,resmx,resmxp integer :: nrhs, nrow, n_row, dim, nv, ne - integer, allocatable :: ivg(:), ipv(:) + integer, allocatable :: ivg(:), ipv(:), perm(:) + character(len=40) :: fname, fnout call psb_init(ictxt) @@ -138,12 +139,15 @@ program zf_sample m_problem = aux_a%get_nrows() call psb_bcast(ictxt,m_problem) - +!!$ call psb_mat_renum(psb_mat_renum_gps_,aux_a,info,perm) + ! At this point aux_b may still be unallocated if (psb_size(aux_b,dim=1) == m_problem) then ! if any rhs were present, broadcast the first one write(psb_err_unit,'("Ok, got an rhs ")') b_col_glob =>aux_b(:,1) +!!$ call psb_gelp('N',perm(1:m_problem),& +!!$ & b_col_glob(1:m_problem),info) else write(psb_out_unit,'("Generating an rhs...")') write(psb_out_unit,'(" ")') @@ -159,7 +163,9 @@ program zf_sample enddo endif call psb_bcast(ictxt,b_col_glob(1:m_problem)) + else + call psb_bcast(ictxt,m_problem) call psb_realloc(m_problem,1,aux_b,ircode) if (ircode /= 0) then @@ -181,6 +187,7 @@ program zf_sample enddo call psb_matdist(aux_a, a, ictxt, & & desc_a,b_col_glob,b_col,info,fmt=afmt,v=ivg) + else if (ipart == 2) then if (iam == psb_root_) then write(psb_out_unit,'("Partition type: graph")') @@ -194,6 +201,7 @@ program zf_sample call getv_mtpart(ivg) call psb_matdist(aux_a, a, ictxt, & & desc_a,b_col_glob,b_col,info,fmt=afmt,v=ivg) + else if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")') call psb_matdist(aux_a, a, ictxt, & @@ -201,10 +209,10 @@ program zf_sample end if call psb_geall(x_col,desc_a,info) - x_col(:) =0.0 + call x_col%set(zzero) call psb_geasb(x_col,desc_a,info) call psb_geall(r_col,desc_a,info) - r_col(:) =0.0 + call r_col%set(zzero) call psb_geasb(r_col,desc_a,info) t2 = psb_wtime() - t1 @@ -248,8 +256,8 @@ program zf_sample call psb_amx(ictxt,t2) call psb_geaxpby(zone,b_col,zzero,r_col,desc_a,info) call psb_spmm(-zone,a,x_col,zone,r_col,desc_a,info) - call psb_genrm2s(resmx,r_col,desc_a,info) - call psb_geamaxs(resmxp,r_col,desc_a,info) + resmx = psb_genrm2(r_col,desc_a,info) + resmxp = psb_geamax(r_col,desc_a,info) amatsize = psb_sizeof(a) descsize = psb_sizeof(desc_a) diff --git a/test/kernel/d_file_spmv.f90 b/test/kernel/d_file_spmv.f90 index 20c770908..1c70b7d78 100644 --- a/test/kernel/d_file_spmv.f90 +++ b/test/kernel/d_file_spmv.f90 @@ -42,9 +42,10 @@ program d_file_spmv ! dense matrices real(psb_dpk_), allocatable, target :: aux_b(:,:), d(:) - real(psb_dpk_), allocatable , save :: b_col(:), x_col(:), r_col(:), & - & x_col_glob(:), r_col_glob(:) + real(psb_dpk_), allocatable , save :: x_col_glob(:), r_col_glob(:) real(psb_dpk_), pointer :: b_col_glob(:) + type(psb_d_vect_type) :: b_col, x_col, r_col + ! communications data structure type(psb_desc_type):: desc_a @@ -114,7 +115,7 @@ program d_file_spmv ! For Matrix Market we have an input file for the matrix ! and an (optional) second file for the RHS. call mm_mat_read(aux_a,info,iunit=iunit,filename=mtrx_file) - if (info == 0) then + if (info == psb_success_) then if (rhs_file /= 'NONE') then call mm_vet_read(aux_b,info,iunit=iunit,filename=rhs_file) end if @@ -129,7 +130,7 @@ program d_file_spmv info = -1 write(psb_err_unit,*) 'Wrong choice for fileformat ', filefmt end select - if (info /= 0) then + if (info /= psb_success_) then write(psb_err_unit,*) 'Error while reading input matrix ' call psb_abort(ictxt) end if @@ -147,7 +148,7 @@ program d_file_spmv write(psb_out_unit,'(" ")') call psb_realloc(m_problem,1,aux_b,ircode) if (ircode /= 0) then - call psb_errpush(4000,name) + call psb_errpush(psb_err_alloc_dealloc_,name) goto 9999 endif @@ -182,18 +183,21 @@ program d_file_spmv enddo call psb_matdist(aux_a, a, ictxt, & & desc_a,b_col_glob,b_col,info,fmt=afmt,v=ivg) + else if (ipart == 2) then if (iam==psb_root_) then write(psb_out_unit,'("Partition type: graph")') write(psb_out_unit,'(" ")') ! write(psb_err_unit,'("Build type: graph")') call build_mtpart(aux_a,np) + endif call psb_barrier(ictxt) call distr_mtpart(psb_root_,ictxt) call getv_mtpart(ivg) call psb_matdist(aux_a, a, ictxt, & & desc_a,b_col_glob,b_col,info,fmt=afmt,v=ivg) + else if (iam==psb_root_) write(psb_out_unit,'("Partition type: default block")') call psb_matdist(aux_a, a, ictxt, & @@ -201,7 +205,7 @@ program d_file_spmv end if call psb_geall(x_col,desc_a,info) - x_col(:) =1.0 + call x_col%set(done) call psb_geasb(x_col,desc_a,info) t2 = psb_wtime() - t1 @@ -264,7 +268,8 @@ program d_file_spmv ! ! This computation is valid for CSR ! - nbytes = nr*(2*psb_sizeof_dp + psb_sizeof_int)+ annz*(psb_sizeof_dp + psb_sizeof_int) + nbytes = nr*(2*psb_sizeof_dp + psb_sizeof_int)+& + & annz*(psb_sizeof_dp + psb_sizeof_int) bdwdth = times*nbytes/(t2*1.d6) write(psb_out_unit,*) write(psb_out_unit,'("MBYTES/S : ",F20.3)') bdwdth diff --git a/test/kernel/s_file_spmv.f90 b/test/kernel/s_file_spmv.f90 index 2b9eb06f2..e3c6d231b 100644 --- a/test/kernel/s_file_spmv.f90 +++ b/test/kernel/s_file_spmv.f90 @@ -42,9 +42,10 @@ program s_file_spmv ! dense matrices real(psb_spk_), allocatable, target :: aux_b(:,:), d(:) - real(psb_spk_), allocatable , save :: b_col(:), x_col(:), r_col(:), & - & x_col_glob(:), r_col_glob(:) + real(psb_spk_), allocatable , save :: x_col_glob(:), r_col_glob(:) real(psb_spk_), pointer :: b_col_glob(:) + type(psb_s_vect_type) :: b_col, x_col, r_col + ! communications data structure type(psb_desc_type):: desc_a @@ -114,7 +115,7 @@ program s_file_spmv ! For Matrix Market we have an input file for the matrix ! and an (optional) second file for the RHS. call mm_mat_read(aux_a,info,iunit=iunit,filename=mtrx_file) - if (info == 0) then + if (info == psb_success_) then if (rhs_file /= 'NONE') then call mm_vet_read(aux_b,info,iunit=iunit,filename=rhs_file) end if @@ -129,7 +130,7 @@ program s_file_spmv info = -1 write(psb_err_unit,*) 'Wrong choice for fileformat ', filefmt end select - if (info /= 0) then + if (info /= psb_success_) then write(psb_err_unit,*) 'Error while reading input matrix ' call psb_abort(ictxt) end if @@ -147,7 +148,7 @@ program s_file_spmv write(psb_out_unit,'(" ")') call psb_realloc(m_problem,1,aux_b,ircode) if (ircode /= 0) then - call psb_errpush(4000,name) + call psb_errpush(psb_err_alloc_dealloc_,name) goto 9999 endif @@ -182,18 +183,21 @@ program s_file_spmv enddo call psb_matdist(aux_a, a, ictxt, & & desc_a,b_col_glob,b_col,info,fmt=afmt,v=ivg) + else if (ipart == 2) then if (iam==psb_root_) then write(psb_out_unit,'("Partition type: graph")') write(psb_out_unit,'(" ")') ! write(psb_err_unit,'("Build type: graph")') call build_mtpart(aux_a,np) + endif call psb_barrier(ictxt) call distr_mtpart(psb_root_,ictxt) call getv_mtpart(ivg) call psb_matdist(aux_a, a, ictxt, & & desc_a,b_col_glob,b_col,info,fmt=afmt,v=ivg) + else if (iam==psb_root_) write(psb_out_unit,'("Partition type: block")') call psb_matdist(aux_a, a, ictxt, & @@ -201,7 +205,7 @@ program s_file_spmv end if call psb_geall(x_col,desc_a,info) - x_col(:) =1.0 + call x_col%set(sone) call psb_geasb(x_col,desc_a,info) t2 = psb_wtime() - t1 @@ -264,7 +268,8 @@ program s_file_spmv ! ! This computation is valid for CSR ! - nbytes = nr*(2*psb_sizeof_sp + psb_sizeof_int)+ annz*(psb_sizeof_sp + psb_sizeof_int) + nbytes = nr*(2*psb_sizeof_sp + psb_sizeof_int)+ & + & annz*(psb_sizeof_sp + psb_sizeof_int) bdwdth = times*nbytes/(t2*1.d6) write(psb_out_unit,*) write(psb_out_unit,'("MBYTES/S : ",F20.3)') bdwdth diff --git a/test/newfmt/ppde.F90 b/test/newfmt/ppde.F90 index 6d4665840..7f5d4f6a8 100644 --- a/test/newfmt/ppde.F90 +++ b/test/newfmt/ppde.F90 @@ -425,7 +425,7 @@ contains ! define rhs from boundary conditions; also build initial guess if (info == psb_success_) call psb_geall(b,desc_a,info) if (info == psb_success_) call psb_geall(xv,desc_a,info) - nlr = psb_cd_get_local_rows(desc_a) + nlr = desc_a%get_local_rows() call psb_barrier(ictxt) talc = psb_wtime()-t0 diff --git a/test/newfmt/spde.f90 b/test/newfmt/spde.f90 index 576e02632..3fb6f2cbb 100644 --- a/test/newfmt/spde.f90 +++ b/test/newfmt/spde.f90 @@ -401,7 +401,7 @@ contains ! define rhs from boundary conditions; also build initial guess if (info == psb_success_) call psb_geall(b,desc_a,info) if (info == psb_success_) call psb_geall(xv,desc_a,info) - nlr = psb_cd_get_local_rows(desc_a) + nlr = desc_a%get_local_rows() call psb_barrier(ictxt) talc = psb_wtime()-t0 diff --git a/test/pargen/ppde.f90 b/test/pargen/ppde.f90 index b8d977cb7..b067b99de 100644 --- a/test/pargen/ppde.f90 +++ b/test/pargen/ppde.f90 @@ -83,7 +83,8 @@ program ppde ! descriptor type(psb_desc_type) :: desc_a, desc_b ! dense matrices - real(psb_dpk_), allocatable :: b(:), x(:) + type(psb_d_vect_type) :: xxv,bv, vtst + real(psb_dpk_), allocatable :: tst(:) ! blacs parameters integer :: ictxt, iam, np @@ -128,7 +129,7 @@ program ppde ! call psb_barrier(ictxt) t1 = psb_wtime() - call create_matrix(idim,a,b,x,desc_a,ictxt,afmt,info) + call create_matrix(idim,a,bv,xxv,desc_a,ictxt,afmt,info) call psb_barrier(ictxt) t2 = psb_wtime() - t1 if(info /= psb_success_) then @@ -139,8 +140,8 @@ program ppde end if if (iam == psb_root_) write(psb_out_unit,'("Overall matrix creation time : ",es12.5)')t2 if (iam == psb_root_) write(psb_out_unit,'(" ")') - write(fname,'(a,i0,a)') 'pde-',idim,'.hb' - call hb_write(a,info,filename=fname,rhs=b,key='PDEGEN',mtitle='MLD2P4 pdegen Test matrix ') +!!$ write(fname,'(a,i0,a)') 'pde-',idim,'.hb' +!!$ call hb_write(a,info,filename=fname,rhs=b,key='PDEGEN',mtitle='MLD2P4 pdegen Test matrix ') !!$ write(fname,'(a,i2.2,a,i2.2,a)') 'amat-',iam,'-',np,'.mtx' !!$ call a%print(fname) !!$ call psb_cdprt(20+iam,desc_a,short=.false.) @@ -181,7 +182,7 @@ program ppde call psb_barrier(ictxt) t1 = psb_wtime() eps = 1.d-9 - call psb_krylov(kmethd,a,prec,b,x,eps,desc_a,info,& + call psb_krylov(kmethd,a,prec,bv,xxv,eps,desc_a,info,& & itmax=itmax,iter=iter,err=err,itrace=itrace,istop=istopc,irst=irst) if(info /= psb_success_) then @@ -194,7 +195,6 @@ program ppde call psb_barrier(ictxt) t2 = psb_wtime() - t1 call psb_amx(ictxt,t2) - amatsize = psb_sizeof(a) descsize = psb_sizeof(desc_a) precsize = psb_sizeof(prec) @@ -215,12 +215,26 @@ program ppde write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%indxmap%get_fmt() write(psb_out_unit,'("Storage type for DESC_B: ",a)') desc_b%indxmap%get_fmt() end if + + ! + if (.false.) then + call psb_geall(tst,desc_b, info) + call psb_geall(vtst,desc_b, info) + vtst%v%v = iam+1 + call psb_geasb(vtst,desc_b,info) + tst = vtst + call psb_geasb(tst,desc_b,info) + call psb_ovrl(vtst,desc_b,info,update=psb_avg_) + call psb_ovrl(tst,desc_b,info,update=psb_avg_) + write(0,*) iam,' After ovrl:',vtst%v%v + write(0,*) iam,' After ovrl:',tst + end if ! ! cleanup storage and exit ! - call psb_gefree(b,desc_a,info) - call psb_gefree(x,desc_a,info) + call psb_gefree(bv,desc_a,info) + call psb_gefree(xxv,desc_a,info) call psb_spfree(a,desc_a,info) call psb_precfree(prec,info) call psb_cdfree(desc_a,info) @@ -346,7 +360,7 @@ contains ! subroutine to allocate and fill in the coefficient matrix and ! the rhs. ! - subroutine create_matrix(idim,a,b,xv,desc_a,ictxt,afmt,info) + subroutine create_matrix(idim,a,bv,xxv,desc_a,ictxt,afmt,info) ! ! discretize the partial diferential equation ! @@ -366,16 +380,16 @@ contains use psb_base_mod use psb_mat_mod implicit none - integer :: idim - integer, parameter :: nb=20 - real(psb_dpk_), allocatable :: b(:),xv(:) - type(psb_desc_type) :: desc_a - integer :: ictxt, info - character :: afmt*5 + integer :: idim + integer, parameter :: nb=20 + type(psb_d_vect_type) :: xxv,bv + type(psb_desc_type) :: desc_a + integer :: ictxt, info + character :: afmt*5 type(psb_dspmat_type) :: a - type(psb_d_csc_sparse_mat) :: acsc - type(psb_d_coo_sparse_mat) :: acoo - type(psb_d_csr_sparse_mat) :: acsr + 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),x,y,z integer :: m,n,nnz,glob_row,nlr,i,ii,ib,k integer :: ix,iy,iz,ia,indx_owner @@ -384,9 +398,8 @@ contains integer, allocatable :: irow(:),icol(:),myidx(:) real(psb_dpk_), allocatable :: val(:) ! deltah dimension of each grid cell - ! deltat discretization time - real(psb_dpk_) :: deltah + real(psb_dpk_) :: deltah, deltah2 real(psb_dpk_),parameter :: rhs=0.d0,one=1.d0,zero=0.d0 real(psb_dpk_) :: t0, t1, t2, t3, tasb, talc, ttot, tgen real(psb_dpk_) :: a1, a2, a3, a4, b1, b2, b3 @@ -401,7 +414,8 @@ contains call psb_info(ictxt, iam, np) - deltah = 1.d0/(idim-1) + deltah = 1.d0/(idim-1) + deltah2 = deltah*deltah ! initialize array descriptor and sparse matrix storage. provide an ! estimate of the number of non zeroes @@ -425,8 +439,8 @@ contains call psb_cdall(ictxt,desc_a,info,nl=nr) if (info == psb_success_) call psb_spall(a,desc_a,info,nnz=nnz) ! define rhs from boundary conditions; also build initial guess - if (info == psb_success_) call psb_geall(b,desc_a,info) - if (info == psb_success_) call psb_geall(xv,desc_a,info) + if (info == psb_success_) call psb_geall(xxv,desc_a,info) + if (info == psb_success_) call psb_geall(bv,desc_a,info) nlr = desc_a%get_local_rows() call psb_barrier(ictxt) talc = psb_wtime()-t0 @@ -493,79 +507,63 @@ contains ! term depending on (x-1,y,z) ! if (ix == 1) then - val(element)=-b1(x,y,z)-a1(x,y,z) - val(element) = val(element)/(deltah*& - & deltah) + val(element) = -b1(x,y,z)/deltah2-a1(x,y,z)/deltah zt(k) = exp(-x**2-y**2-z**2)*(-val(element)) else - val(element)=-b1(x,y,z)-a1(x,y,z) - val(element) = val(element)/(deltah*& - & deltah) + val(element) = -b1(x,y,z)/deltah2-a1(x,y,z)/deltah icol(element) = (ix-2)*idim*idim+(iy-1)*idim+(iz) irow(element) = glob_row element = element+1 endif ! term depending on (x,y-1,z) if (iy == 1) then - val(element)=-b2(x,y,z)-a2(x,y,z) - val(element) = val(element)/(deltah*& - & deltah) + val(element) = -b2(x,y,z)/deltah2-a2(x,y,z)/deltah zt(k) = exp(-x**2-y**2-z**2)*exp(-x)*(-val(element)) else - val(element)=-b2(x,y,z)-a2(x,y,z) - val(element) = val(element)/(deltah*deltah) + val(element) = -b2(x,y,z)/deltah2-a2(x,y,z)/deltah icol(element) = (ix-1)*idim*idim+(iy-2)*idim+(iz) irow(element) = glob_row element = element+1 endif ! term depending on (x,y,z-1) if (iz == 1) then - val(element)=-b3(x,y,z)-a3(x,y,z) - val(element) = val(element)/(deltah*deltah) + val(element)=-b3(x,y,z)/deltah2-a3(x,y,z)/deltah zt(k) = exp(-x**2-y**2-z**2)*exp(-x)*(-val(element)) else - val(element)=-b3(x,y,z)-a3(x,y,z) - val(element) = val(element)/(deltah*deltah) + val(element)=-b3(x,y,z)/deltah2-a3(x,y,z)/deltah icol(element) = (ix-1)*idim*idim+(iy-1)*idim+(iz-1) irow(element) = glob_row element = element+1 endif ! term depending on (x,y,z) - val(element)=2*b1(x,y,z) + 2*b2(x,y,z)& - & + 2*b3(x,y,z) + a1(x,y,z)& - & + a2(x,y,z) + a3(x,y,z) - val(element) = val(element)/(deltah*deltah) + val(element)=(2*b1(x,y,z) + 2*b2(x,y,z) + 2*b3(x,y,z))/deltah2& + & + (a1(x,y,z) + a2(x,y,z) + a3(x,y,z)+ a4(x,y,z))/deltah icol(element) = (ix-1)*idim*idim+(iy-1)*idim+(iz) irow(element) = glob_row element = element+1 ! term depending on (x,y,z+1) if (iz == idim) then - val(element)=-b1(x,y,z) - val(element) = val(element)/(deltah*deltah) + val(element)=-b1(x,y,z)/deltah2 zt(k) = exp(-x**2-y**2-z**2)*exp(-x)*(-val(element)) else - val(element)=-b1(x,y,z) - val(element) = val(element)/(deltah*deltah) + val(element)=-b1(x,y,z)/deltah2 icol(element) = (ix-1)*idim*idim+(iy-1)*idim+(iz+1) irow(element) = glob_row element = element+1 endif ! term depending on (x,y+1,z) if (iy == idim) then - val(element)=-b2(x,y,z) - val(element) = val(element)/(deltah*deltah) + val(element)=-b2(x,y,z)/deltah2 zt(k) = exp(-x**2-y**2-z**2)*exp(-x)*(-val(element)) else - val(element)=-b2(x,y,z) - val(element) = val(element)/(deltah*deltah) + val(element)=-b2(x,y,z)/deltah2 icol(element) = (ix-1)*idim*idim+(iy)*idim+(iz) irow(element) = glob_row element = element+1 endif ! term depending on (x+1,y,z) if (ix 0) read(infile,fmt=fmt11)rhstype,nrhs,nrhsix + + call acsc%allocate(nrow,ncol,nnzero) + if (ircode /= 0 ) then + write(psb_err_unit,*) 'Memory allocation failed' + goto 993 + end if + + if (present(mtitle)) mtitle=mtitle_ + + + if (psb_tolower(type(1:1)) == 'c') then + if (psb_tolower(type(2:2)) == 'u') then + + + read (infile,fmt=ptrfmt) (acsc%icp(i),i=1,ncol+1) + read (infile,fmt=indfmt) (acsc%ia(i),i=1,nnzero) + if (valcrd > 0) read (infile,fmt=valfmt) (acsc%val(i),i=1,nnzero) + + call a%mv_from(acsc) + + if (present(b)) then + if ((psb_toupper(rhstype(1:1)) == 'F').and.(rhscrd > 0)) then + call psb_realloc(nrow,1,b,info) + read (infile,fmt=rhsfmt) (b(i,1),i=1,nrow) + endif + endif + if (present(g)) then + if ((psb_toupper(rhstype(2:2)) == 'G').and.(rhscrd > 0)) then + call psb_realloc(nrow,1,g,info) + read (infile,fmt=rhsfmt) (g(i,1),i=1,nrow) + endif + endif + if (present(x)) then + if ((psb_toupper(rhstype(3:3)) == 'X').and.(rhscrd > 0)) then + call psb_realloc(nrow,1,x,info) + read (infile,fmt=rhsfmt) (x(i,1),i=1,nrow) + endif + endif + + else if (psb_tolower(type(2:2)) == 's') then + + ! we are generally working with non-symmetric matrices, so + ! we de-symmetrize what we are about to read + + read (infile,fmt=ptrfmt) (acsc%icp(i),i=1,ncol+1) + read (infile,fmt=indfmt) (acsc%ia(i),i=1,nnzero) + if (valcrd > 0) read (infile,fmt=valfmt) (acsc%val(i),i=1,nnzero) + + + if (present(b)) then + if ((psb_toupper(rhstype(1:1)) == 'F').and.(rhscrd > 0)) then + call psb_realloc(nrow,1,b,info) + read (infile,fmt=rhsfmt) (b(i,1),i=1,nrow) + endif + endif + if (present(g)) then + if ((psb_toupper(rhstype(2:2)) == 'G').and.(rhscrd > 0)) then + call psb_realloc(nrow,1,g,info) + read (infile,fmt=rhsfmt) (g(i,1),i=1,nrow) + endif + endif + if (present(x)) then + if ((psb_toupper(rhstype(3:3)) == 'X').and.(rhscrd > 0)) then + call psb_realloc(nrow,1,x,info) + read (infile,fmt=rhsfmt) (x(i,1),i=1,nrow) + endif + endif + + + call acoo%mv_from_fmt(acsc,info) + call acoo%reallocate(2*nnzero) + ! A is now in COO format + nzr = nnzero + do i=1,nnzero + if (acoo%ia(i) /= acoo%ja(i)) then + nzr = nzr + 1 + acoo%val(nzr) = acoo%val(i) + acoo%ia(nzr) = acoo%ja(i) + acoo%ja(nzr) = acoo%ia(i) + end if + end do + call acoo%set_nzeros(nzr) + call acoo%fix(ircode) + if (ircode == 0) call a%mv_from(acoo) + if (ircode /= 0) goto 993 + + else if (psb_tolower(type(2:2)) == 'h') then + + ! we are generally working with non-symmetric matrices, so + ! we de-symmetrize what we are about to read + + read (infile,fmt=ptrfmt) (acsc%icp(i),i=1,ncol+1) + read (infile,fmt=indfmt) (acsc%ia(i),i=1,nnzero) + if (valcrd > 0) read (infile,fmt=valfmt) (acsc%val(i),i=1,nnzero) + + + if (present(b)) then + if ((psb_toupper(rhstype(1:1)) == 'F').and.(rhscrd > 0)) then + call psb_realloc(nrow,1,b,info) + read (infile,fmt=rhsfmt) (b(i,1),i=1,nrow) + endif + endif + if (present(g)) then + if ((psb_toupper(rhstype(2:2)) == 'G').and.(rhscrd > 0)) then + call psb_realloc(nrow,1,g,info) + read (infile,fmt=rhsfmt) (g(i,1),i=1,nrow) + endif + endif + if (present(x)) then + if ((psb_toupper(rhstype(3:3)) == 'X').and.(rhscrd > 0)) then + call psb_realloc(nrow,1,x,info) + read (infile,fmt=rhsfmt) (x(i,1),i=1,nrow) + endif + endif + + + call acoo%mv_from_fmt(acsc,info) + call acoo%reallocate(2*nnzero) + ! A is now in COO format + nzr = nnzero + do i=1,nnzero + if (acoo%ia(i) /= acoo%ja(i)) then + nzr = nzr + 1 + acoo%val(nzr) = conjg(acoo%val(i)) + acoo%ia(nzr) = acoo%ja(i) + acoo%ja(nzr) = acoo%ia(i) + end if + end do + call acoo%set_nzeros(nzr) + call acoo%fix(ircode) + if (ircode == 0) call a%mv_from(acoo) + if (ircode /= 0) goto 993 + + else + write(psb_err_unit,*) 'read_matrix: matrix type not yet supported' + iret=904 + end if + else + write(psb_err_unit,*) 'read_matrix: matrix type not yet supported' + iret=904 + end if + + call a%cscnv(ircode,type='csr') + if (infile /= 5) close(infile) + + return + + ! open failed +901 iret=901 + write(psb_err_unit,*) 'read_matrix: could not open file ',filename,' for input' + return +902 iret=902 + write(psb_err_unit,*) 'HB_READ: Unexpected end of file ' + return +993 iret=993 + write(psb_err_unit,*) 'HB_READ: Memory allocation failure' + return +end subroutine chb_read + +subroutine chb_write(a,iret,iunit,filename,key,rhs,g,x,mtitle) + use psb_base_mod + implicit none + type(psb_cspmat_type), intent(in), target :: a + integer, intent(out) :: iret + character(len=*), optional, intent(in) :: mtitle + integer, optional, intent(in) :: iunit + character(len=*), optional, intent(in) :: filename + character(len=*), optional, intent(in) :: key + complex(psb_spk_), optional :: rhs(:), g(:), x(:) + integer :: iout + + character(len=*), parameter:: ptrfmt='(10I8)',indfmt='(10I8)' + integer, parameter :: jptr=10,jind=10 + character(len=*), parameter:: valfmt='(4E20.12)',rhsfmt='(4E20.12)' + integer, parameter :: jval=2,jrhs=2 + character(len=*), parameter :: fmt10='(a72,a8,/,5i14,/,a3,11x,4i14,/,2a16,2a20)' + character(len=*), parameter :: fmt11='(a3,11x,2i14)' + character(len=*), parameter :: fmt111='(1x,a8,1x,i8,1x,a10)' + + type(psb_c_csc_sparse_mat), target :: acsc + type(psb_c_csc_sparse_mat), pointer :: acpnt + character(len=72) :: mtitle_ + character(len=8) :: key_ + + character :: rhstype*3,type*3 + + integer :: i,indcrd,ptrcrd,rhscrd,totcrd,valcrd,& + & nrow,ncol,nnzero, neltvl, nrhs, nrhsix + + iret = 0 + + if (present(filename)) then + if (filename == '-') then + iout=6 + else + if (present(iunit)) then + iout = iunit + else + iout=99 + endif + open(iout,file=filename, err=901, action='WRITE') + endif + else + if (present(iunit)) then + iout = iunit + else + iout=6 + endif + endif + + if (present(mtitle)) then + mtitle_ = mtitle + else + mtitle_ = 'Temporary PSBLAS title ' + endif + if (present(key)) then + key_ = key + else + key_ = 'PSBMAT00' + endif + + + select type(aa=>a%a) + type is (psb_c_csc_sparse_mat) + + acpnt => aa + + class default + + call acsc%cp_from_fmt(aa, iret) + if (iret /= 0) return + acpnt => acsc + + end select + + + nrow = acpnt%get_nrows() + ncol = acpnt%get_ncols() + nnzero = acpnt%get_nzeros() + + neltvl = 0 + + ptrcrd = (ncol+1)/jptr + if (mod(ncol+1,jptr) > 0) ptrcrd = ptrcrd + 1 + indcrd = nnzero/jind + if (mod(nnzero,jind) > 0) indcrd = indcrd + 1 + valcrd = nnzero/jval + if (mod(nnzero,jval) > 0) valcrd = valcrd + 1 + rhstype = '' + if (present(rhs)) then + if (size(rhs) 0) rhscrd = rhscrd + 1 + endif + nrhs = 1 + rhstype(1:1) = 'F' + else + rhscrd = 0 + nrhs = 0 + end if + totcrd = ptrcrd + indcrd + valcrd + rhscrd + + nrhsix = nrhs*nrow + + if (present(g)) then + rhstype(2:2) = 'G' + end if + if (present(x)) then + rhstype(3:3) = 'X' + end if + type = 'CUA' + + write (iout,fmt=fmt10) mtitle_,key_,totcrd,ptrcrd,indcrd,valcrd,rhscrd,& + & type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt + if (rhscrd > 0) write (iout,fmt=fmt11) rhstype,nrhs,nrhsix + write (iout,fmt=ptrfmt) (acpnt%icp(i),i=1,ncol+1) + write (iout,fmt=indfmt) (acpnt%ia(i),i=1,nnzero) + if (valcrd > 0) write (iout,fmt=valfmt) (acpnt%val(i),i=1,nnzero) + if (rhscrd > 0) write (iout,fmt=rhsfmt) (rhs(i),i=1,nrow) + if (present(g).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (g(i),i=1,nrow) + if (present(x).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (x(i),i=1,nrow) + + + + + if (iout /= 6) close(iout) + + + return + +901 continue + iret=901 + write(psb_err_unit,*) 'Error while opening ',filename + return +end subroutine chb_write diff --git a/util/psb_c_mat_dist_impl.f90 b/util/psb_c_mat_dist_impl.f90 new file mode 100644 index 000000000..28bd36f84 --- /dev/null +++ b/util/psb_c_mat_dist_impl.f90 @@ -0,0 +1,470 @@ +!!$ +!!$ Parallel Sparse BLAS version 3.0 +!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine cmatdist(a_glob, a, ictxt, desc_a,& + & b_glob, b, info, parts, v, inroot,fmt,mold) + ! + ! an utility subroutine to distribute a matrix among processors + ! according to a user defined data distribution, using + ! sparse matrix subroutines. + ! + ! type(d_spmat) :: a_glob + ! on entry: this contains the global sparse matrix as follows: + ! a%fida == 'csr' + ! a%aspk for coefficient values + ! a%ia1 for column indices + ! a%ia2 for row pointers + ! a%m for number of global matrix rows + ! a%k for number of global matrix columns + ! on exit : undefined, with unassociated pointers. + ! + ! type(d_spmat) :: a + ! on entry: fresh variable. + ! on exit : this will contain the local sparse matrix. + ! + ! interface parts + ! ! .....user passed subroutine..... + ! subroutine parts(global_indx,n,np,pv,nv) + ! implicit none + ! integer, intent(in) :: global_indx, n, np + ! integer, intent(out) :: nv + ! integer, intent(out) :: pv(*) + ! + ! end subroutine parts + ! end interface + ! on entry: subroutine providing user defined data distribution. + ! for each global_indx the subroutine should return + ! the list pv of all processes owning the row with + ! that index; the list will contain nv entries. + ! usually nv=1; if nv >1 then we have an overlap in the data + ! distribution. + ! + ! integer :: ictxt + ! on entry: blacs context. + ! on exit : unchanged. + ! + ! type (desc_type) :: desc_a + ! on entry: fresh variable. + ! on exit : the updated array descriptor + ! + ! real(psb_dpk_), optional :: b_glob(:) + ! on entry: this contains right hand side. + ! on exit : + ! + ! real(psb_dpk_), allocatable, optional :: b(:) + ! on entry: fresh variable. + ! on exit : this will contain the local right hand side. + ! + ! integer, optional :: inroot + ! on entry: specifies processor holding a_glob. default: 0 + ! on exit : unchanged. + ! + use psb_base_mod + use psb_mat_mod + implicit none + + ! parameters + type(psb_cspmat_type) :: a_glob + complex(psb_spk_) :: b_glob(:) + integer :: ictxt + type(psb_cspmat_type) :: a + type(psb_c_vect_type) :: b + type(psb_desc_type) :: desc_a + integer, intent(out) :: info + integer, optional :: inroot + character(len=5), optional :: fmt + class(psb_c_base_sparse_mat), optional :: mold + + integer :: v(:) + interface + subroutine parts(global_indx,n,np,pv,nv) + implicit none + integer, intent(in) :: global_indx, n, np + integer, intent(out) :: nv + integer, intent(out) :: pv(*) + end subroutine parts + end interface + optional :: parts, v + + ! local variables + logical :: use_parts, use_v + integer :: np, iam + integer :: length_row, i_count, j_count,& + & k_count, root, liwork, nrow, ncol, nnzero, nrhs,& + & i, ll, nz, isize, iproc, nnr, err, err_act, int_err(5) + integer, allocatable :: iwork(:) + integer, allocatable :: irow(:),icol(:) + complex(psb_spk_), allocatable :: val(:) + integer, parameter :: nb=30 + real(psb_dpk_) :: t0, t1, t2, t3, t4, t5 + character(len=20) :: name, ch_err + + info = psb_success_ + err = 0 + name = 'mat_distf' + call psb_erractionsave(err_act) + + ! executable statements + if (present(inroot)) then + root = inroot + else + root = psb_root_ + end if + call psb_info(ictxt, iam, np) + if (iam == root) then + nrow = a_glob%get_nrows() + ncol = a_glob%get_ncols() + if (nrow /= ncol) then + write(psb_err_unit,*) 'a rectangular matrix ? ',nrow,ncol + info=-1 + call psb_errpush(info,name) + goto 9999 + endif + nnzero = a_glob%get_nzeros() + nrhs = 1 + endif + + use_parts = present(parts) + use_v = present(v) + if (count((/ use_parts, use_v /)) /= 1) then + info=psb_err_no_optional_arg_ + call psb_errpush(info,name,a_err=" v, parts") + goto 9999 + endif + + ! broadcast informations to other processors + call psb_bcast(ictxt,nrow, root) + call psb_bcast(ictxt,ncol, root) + call psb_bcast(ictxt,nnzero, root) + call psb_bcast(ictxt,nrhs, root) + liwork = max(np, nrow + ncol) + allocate(iwork(liwork), stat = info) + if (info /= psb_success_) then + info=psb_err_alloc_request_ + int_err(1)=liwork + call psb_errpush(info,name,i_err=int_err,a_err='integer') + goto 9999 + endif + if (iam == root) then + write (*, fmt = *) 'start matdist',root, size(iwork),& + &nrow, ncol, nnzero,nrhs + endif + if (use_parts) then + call psb_cdall(ictxt,desc_a,info,mg=nrow,parts=parts) + else if (use_v) then + call psb_cdall(ictxt,desc_a,info,vg=v) + else + info = -1 + end if + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_cdall' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + call psb_spall(a,desc_a,info,nnz=((nnzero+np-1)/np)) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_psspall' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + call psb_geall(b,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_psdsall' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + + + isize = 3*nb*max(((nnzero+nrow)/nrow),nb) + allocate(val(isize),irow(isize),icol(isize),stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='Allocate' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + i_count = 1 + + do while (i_count <= nrow) + + if (use_parts) then + call parts(i_count,nrow,np,iwork, length_row) + if (length_row == 1) then + j_count = i_count + iproc = iwork(1) + do + j_count = j_count + 1 + if (j_count-i_count >= nb) exit + if (j_count > nrow) exit + call parts(j_count,nrow,np,iwork, length_row) + if (length_row /= 1 ) exit + if (iwork(1) /= iproc ) exit + end do + end if + else + length_row = 1 + j_count = i_count + iproc = v(i_count) + + do + j_count = j_count + 1 + if (j_count-i_count >= nb) exit + if (j_count > nrow) exit + if (v(j_count) /= iproc ) exit + end do + end if + + if (length_row == 1) then + ! now we should insert rows i_count..j_count-1 + nnr = j_count - i_count + + if (iam == root) then + + ll = 0 + do i= i_count, j_count-1 + call a_glob%csget(i,i,nz,& + & irow,icol,val,info,nzin=ll,append=.true.) + if (info /= psb_success_) then + if (nz >min(size(irow(ll+1:)),size(icol(ll+1:)),size(val(ll+1:)))) then + write(psb_err_unit,*) 'Allocation failure? This should not happen!' + end if + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + ll = ll + nz + end do + + if (iproc == iam) then + call psb_spins(ll,irow,icol,val,a,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_spins' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + call psb_geins(nnr,(/(i,i=i_count,j_count-1)/),b_glob(i_count:j_count-1),& + & b,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_ins' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + else + call psb_snd(ictxt,nnr,iproc) + call psb_snd(ictxt,ll,iproc) + call psb_snd(ictxt,irow(1:ll),iproc) + call psb_snd(ictxt,icol(1:ll),iproc) + call psb_snd(ictxt,val(1:ll),iproc) + call psb_snd(ictxt,b_glob(i_count:j_count-1),iproc) + call psb_rcv(ictxt,ll,iproc) + endif + else if (iam /= root) then + + if (iproc == iam) then + call psb_rcv(ictxt,nnr,root) + call psb_rcv(ictxt,ll,root) + if (ll > size(irow)) then + write(psb_err_unit,*) iam,'need to reallocate ',ll + deallocate(val,irow,icol) + allocate(val(ll),irow(ll),icol(ll),stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='Allocate' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + endif + call psb_rcv(ictxt,irow(1:ll),root) + call psb_rcv(ictxt,icol(1:ll),root) + call psb_rcv(ictxt,val(1:ll),root) + call psb_rcv(ictxt,b_glob(i_count:i_count+nnr-1),root) + call psb_snd(ictxt,ll,root) + call psb_spins(ll,irow,icol,val,a,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psspins' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + call psb_geins(nnr,(/(i,i=i_count,i_count+nnr-1)/),& + & b_glob(i_count:i_count+nnr-1),b,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psdsins' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + endif + endif + + i_count = j_count + + else + + ! here processors are counted 1..np + do j_count = 1, length_row + k_count = iwork(j_count) + if (iam == root) then + + ll = 0 + do i= i_count, i_count + call a_glob%csget(i,i,nz,& + & irow,icol,val,info,nzin=ll,append=.true.) + if (info /= psb_success_) then + if (nz >min(size(irow(ll+1:)),size(icol(ll+1:)),size(val(ll+1:)))) then + write(psb_err_unit,*) 'Allocation failure? This should not happen!' + end if + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + ll = ll + nz + end do + + if (k_count == iam) then + + call psb_spins(ll,irow,icol,val,a,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psspins' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + call psb_geins(1,(/i_count/),b_glob(i_count:i_count),& + & b,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psdsins' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + else + call psb_snd(ictxt,ll,k_count) + call psb_snd(ictxt,irow(1:ll),k_count) + call psb_snd(ictxt,icol(1:ll),k_count) + call psb_snd(ictxt,val(1:ll),k_count) + call psb_snd(ictxt,b_glob(i_count),k_count) + call psb_rcv(ictxt,ll,k_count) + endif + else if (iam /= root) then + if (k_count == iam) then + call psb_rcv(ictxt,ll,root) + call psb_rcv(ictxt,irow(1:ll),root) + call psb_rcv(ictxt,icol(1:ll),root) + call psb_rcv(ictxt,val(1:ll),root) + call psb_rcv(ictxt,b_glob(i_count),root) + call psb_snd(ictxt,ll,root) + call psb_spins(ll,irow,icol,val,a,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psspins' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + call psb_geins(1,(/i_count/),b_glob(i_count:i_count),& + & b,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psdsins' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + endif + endif + end do + i_count = i_count + 1 + endif + end do + + call psb_barrier(ictxt) + t0 = psb_wtime() + call psb_cdasb(desc_a,info) + t1 = psb_wtime() + if(info /= psb_success_)then + info=psb_err_from_subroutine_ + ch_err='psb_cdasb' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + call psb_barrier(ictxt) + t2 = psb_wtime() + call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=fmt,mold=mold) + t3 = psb_wtime() + if(info /= psb_success_)then + info=psb_err_from_subroutine_ + ch_err='psb_spasb' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + + if (iam == root) then + write(psb_out_unit,*) 'descriptor assembly: ',t1-t0 + write(psb_out_unit,*) 'sparse matrix assembly: ',t3-t2 + end if + + call psb_geasb(b,desc_a,info) + if(info /= psb_success_)then + info=psb_err_from_subroutine_ + ch_err='psdsasb' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + deallocate(val,irow,icol,stat=info) + if(info /= psb_success_)then + info=psb_err_from_subroutine_ + ch_err='deallocate' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + deallocate(iwork) + if (iam == root) write (*, fmt = *) 'end matdist' + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end subroutine cmatdist diff --git a/util/psb_c_mmio_impl.f90 b/util/psb_c_mmio_impl.f90 new file mode 100644 index 000000000..93109c8b8 --- /dev/null +++ b/util/psb_c_mmio_impl.f90 @@ -0,0 +1,392 @@ +!!$ +!!$ Parallel Sparse BLAS version 3.0 +!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine mm_cvet_read(b, info, iunit, filename) + use psb_base_mod + implicit none + complex(psb_spk_), allocatable, intent(out) :: b(:,:) + integer, intent(out) :: info + integer, optional, intent(in) :: iunit + character(len=*), optional, intent(in) :: filename + integer :: nrow, ncol, i,root, np, me, ircode, j,infile + real(psb_spk_) :: bre, bim + character :: mmheader*15, fmt*15, object*10, type*10, sym*15,& + & line*1024 + + info = psb_success_ + if (present(filename)) then + if (filename == '-') then + infile=5 + else + if (present(iunit)) then + infile=iunit + else + infile=99 + endif + open(infile,file=filename, status='OLD', err=901, action='READ') + endif + else + if (present(iunit)) then + infile=iunit + else + infile=5 + endif + endif + + read(infile,fmt=*, end=902) mmheader, object, fmt, type, sym + + if ( (object /= 'matrix').or.(fmt /= 'array')) then + write(psb_err_unit,*) 'read_rhs: input file type not yet supported' + info = -3 + return + end if + + do + read(infile,fmt='(a)') line + if (line(1:1) /= '%') exit + end do + + read(line,fmt=*)nrow,ncol + + if ((psb_tolower(type) == 'real').and.(psb_tolower(sym) == 'general')) then + allocate(b(nrow,ncol),stat = ircode) + if (ircode /= 0) goto 993 + do j=1, ncol + do i=1, nrow + read(infile,fmt=*,end=902) bre,bim + b(i,j) = cmplx(bre,bim,kind=psb_spk_) + end do + end do + + end if ! read right hand sides + if (infile /= 5) close(infile) + + return + ! open failed +901 write(psb_err_unit,*) 'mm_vet_read: could not open file ',& + & infile,' for input' + info = -1 + return + +902 write(psb_err_unit,*) 'mmv_vet_read: unexpected end of file ',infile,& + & ' during input' + info = -2 + return +993 write(psb_err_unit,*) 'mm_vet_read: memory allocation failure' + info = -3 + return +end subroutine mm_cvet_read + + +subroutine mm_cvet2_write(b, header, info, iunit, filename) + use psb_base_mod + implicit none + complex(psb_spk_), intent(in) :: b(:,:) + character(len=*), intent(in) :: header + integer, intent(out) :: info + integer, optional, intent(in) :: iunit + character(len=*), optional, intent(in) :: filename + integer :: nrow, ncol, i,root, np, me, ircode, j, outfile + + character(len=80) :: frmtv + + info = psb_success_ + if (present(filename)) then + if (filename == '-') then + outfile=6 + else + if (present(iunit)) then + outfile=iunit + else + outfile=99 + endif + open(outfile,file=filename, err=901, action='WRITE') + endif + else + if (present(iunit)) then + outfile=iunit + else + outfile=6 + endif + endif + + write(outfile,'(a)') '%%MatrixMarket matrix array real general' + write(outfile,'(a)') '% '//trim(header) + write(outfile,'(a)') '% ' + nrow = size(b,1) + ncol = size(b,2) + write(outfile,*) nrow,ncol + + write(frmtv,'(a,i5.5,a)') '(',2*ncol,'(es26.18,1x))' + + do i=1,size(b,1) + write(outfile,frmtv) b(i,1:ncol) + end do + + if (outfile /= 6) close(outfile) + + return + ! open failed +901 write(psb_err_unit,*) 'mm_vet_write: could not open file ',& + & outfile,' for output' + info = -1 + return + +end subroutine mm_cvet2_write + +subroutine mm_cvet1_write(b, header, info, iunit, filename) + use psb_base_mod + implicit none + complex(psb_spk_), intent(in) :: b(:) + character(len=*), intent(in) :: header + integer, intent(out) :: info + integer, optional, intent(in) :: iunit + character(len=*), optional, intent(in) :: filename + integer :: nrow, ncol, i,root, np, me, ircode, j, outfile + + character(len=80) :: frmtv + + info = psb_success_ + if (present(filename)) then + if (filename == '-') then + outfile=6 + else + if (present(iunit)) then + outfile=iunit + else + outfile=99 + endif + open(outfile,file=filename, err=901, action='WRITE') + endif + else + if (present(iunit)) then + outfile=iunit + else + outfile=6 + endif + endif + + write(outfile,'(a)') '%%MatrixMarket matrix array real general' + write(outfile,'(a)') '% '//trim(header) + write(outfile,'(a)') '% ' + nrow = size(b,1) + ncol = 1 + write(outfile,*) nrow,ncol + + write(frmtv,'(a,i5.5,a)') '(',2*ncol,'(es26.18,1x))' + + do i=1,size(b,1) + write(outfile,frmtv) b(i) + end do + + if (outfile /= 6) close(outfile) + + return + ! open failed +901 write(psb_err_unit,*) 'mm_vet_write: could not open file ',& + & outfile,' for output' + info = -1 + return + +end subroutine mm_cvet1_write + +subroutine cmm_mat_read(a, info, iunit, filename) + use psb_base_mod + implicit none + type(psb_cspmat_type), intent(out) :: a + integer, intent(out) :: info + integer, optional, intent(in) :: iunit + character(len=*), optional, intent(in) :: filename + character :: mmheader*15, fmt*15, object*10, type*10, sym*15 + character(1024) :: line + integer :: nrow, ncol, nnzero + integer :: ircode, i,nzr,infile + type(psb_c_coo_sparse_mat), allocatable :: acoo + real(psb_spk_) :: are, aim + info = psb_success_ + + if (present(filename)) then + if (filename == '-') then + infile=5 + else + if (present(iunit)) then + infile=iunit + else + infile=99 + endif + open(infile,file=filename, status='OLD', err=901, action='READ') + endif + else + if (present(iunit)) then + infile=iunit + else + infile=5 + endif + endif + + read(infile,fmt=*,end=902) mmheader, object, fmt, type, sym + + if ( (psb_tolower(object) /= 'matrix').or.(psb_tolower(fmt) /= 'coordinate')) then + write(psb_err_unit,*) 'READ_MATRIX: input file type not yet supported' + info=909 + return + end if + + do + read(infile,fmt='(a)') line + if (line(1:1) /= '%') exit + end do + read(line,fmt=*) nrow,ncol,nnzero + + allocate(acoo, stat=ircode) + if (ircode /= 0) goto 993 + if ((psb_tolower(type) == 'complex').and.(psb_tolower(sym) == 'general')) then + call acoo%allocate(nrow,ncol,nnzero) + do i=1,nnzero + read(infile,fmt=*,end=902) acoo%ia(i),acoo%ja(i),are,aim + acoo%val(i) = cmplx(are,aim,kind=psb_spk_) + end do + call acoo%set_nzeros(nnzero) + call acoo%fix(info) + + call a%mv_from(acoo) + call a%cscnv(ircode,type='csr') + + else if ((psb_tolower(type) == 'complex').and.(psb_tolower(sym) == 'symmetric')) then + ! we are generally working with non-symmetric matrices, so + ! we de-symmetrize what we are about to read + call acoo%allocate(nrow,ncol,2*nnzero) + do i=1,nnzero + read(infile,fmt=*,end=902) acoo%ia(i),acoo%ja(i),are,aim + acoo%val(i) = cmplx(are,aim,kind=psb_spk_) + end do + nzr = nnzero + do i=1,nnzero + if (acoo%ia(i) /= acoo%ja(i)) then + nzr = nzr + 1 + acoo%val(nzr) = acoo%val(i) + acoo%ia(nzr) = acoo%ja(i) + acoo%ja(nzr) = acoo%ia(i) + end if + end do + call acoo%set_nzeros(nzr) + call acoo%fix(info) + + call a%mv_from(acoo) + call a%cscnv(ircode,type='csr') + + else if ((psb_tolower(type) == 'complex').and.(psb_tolower(sym) == 'hermitian')) then + ! we are generally working with non-symmetric matrices, so + ! we de-symmetrize what we are about to read + call acoo%allocate(nrow,ncol,2*nnzero) + do i=1,nnzero + read(infile,fmt=*,end=902) acoo%ia(i),acoo%ja(i),are,aim + acoo%val(i) = cmplx(are,aim,kind=psb_spk_) + end do + nzr = nnzero + do i=1,nnzero + if (acoo%ia(i) /= acoo%ja(i)) then + nzr = nzr + 1 + acoo%val(nzr) = conjg(acoo%val(i)) + acoo%ia(nzr) = acoo%ja(i) + acoo%ja(nzr) = acoo%ia(i) + end if + end do + call acoo%set_nzeros(nzr) + call acoo%fix(info) + + call a%mv_from(acoo) + call a%cscnv(ircode,type='csr') + + else + write(psb_err_unit,*) 'read_matrix: matrix type not yet supported' + info=904 + end if + if (infile /= 5) close(infile) + return + + ! open failed +901 info=901 + write(psb_err_unit,*) 'read_matrix: could not open file ',filename,' for input' + return +902 info=902 + write(psb_err_unit,*) 'READ_MATRIX: Unexpected end of file ' + return +993 info=993 + write(psb_err_unit,*) 'READ_MATRIX: Memory allocation failure' + return +end subroutine cmm_mat_read + + +subroutine cmm_mat_write(a,mtitle,info,iunit,filename) + use psb_base_mod + implicit none + type(psb_cspmat_type), intent(in) :: a + integer, intent(out) :: info + character(len=*), intent(in) :: mtitle + integer, optional, intent(in) :: iunit + character(len=*), optional, intent(in) :: filename + integer :: iout + + + info = psb_success_ + + if (present(filename)) then + if (filename == '-') then + iout=6 + else + if (present(iunit)) then + iout = iunit + else + iout=99 + endif + open(iout,file=filename, err=901, action='WRITE') + endif + else + if (present(iunit)) then + iout = iunit + else + iout=6 + endif + endif + + call a%print(iout,head=mtitle) + + if (iout /= 6) close(iout) + + + return + +901 continue + info=901 + write(psb_err_unit,*) 'Error while opening ',filename + return +end subroutine cmm_mat_write diff --git a/util/psb_c_renum_impl.F90 b/util/psb_c_renum_impl.F90 new file mode 100644 index 000000000..0905e9fdc --- /dev/null +++ b/util/psb_c_renum_impl.F90 @@ -0,0 +1,142 @@ +subroutine psb_c_mat_renum(alg,mat,info,perm) + use psb_base_mod + use psb_renum_mod, psb_protect_name => psb_c_mat_renum + implicit none + integer, intent(in) :: alg + type(psb_cspmat_type), intent(inout) :: mat + integer, intent(out) :: info + integer, allocatable, optional, intent(out) :: perm(:) + + integer :: err_act + character(len=20) :: name + + info = psb_success_ + name = 'mat_renum' + call psb_erractionsave(err_act) + + info = psb_success_ + + select case (alg) + case(psb_mat_renum_gps_) + + call psb_mat_renum_gps(mat,info,perm) + + case default + info = psb_err_input_value_invalid_i_ + call psb_errpush(info,name,i_err=(/1,alg,0,0,0/)) + goto 9999 + end select + + if (info /= psb_success_) then + info = psb_err_from_subroutine_non_ + 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 psb_mat_renum_gps(a,info,operm) + use psb_base_mod + use psb_gps_mod + implicit none + type(psb_cspmat_type), intent(inout) :: a + integer, intent(out) :: info + integer, allocatable, optional, intent(out) :: operm(:) + + ! + class(psb_c_base_sparse_mat), allocatable :: aa + type(psb_c_csr_sparse_mat) :: acsr + type(psb_c_coo_sparse_mat) :: acoo + + integer :: err_act + character(len=20) :: name + integer, allocatable :: ndstk(:,:), iold(:), ndeg(:), perm(:) + integer :: i, j, k, ideg, nr, ibw, ipf, idpth + + info = psb_success_ + name = 'mat_renum' + call psb_erractionsave(err_act) + + info = psb_success_ + + call a%mold(aa) + call a%mv_to(aa) + call aa%mv_to_fmt(acsr,info) + ! Insert call to gps_reduce + nr = acsr%get_nrows() + ideg = 0 + do i=1, nr + ideg = max(ideg,acsr%irp(i+1)-acsr%irp(i)) + end do + allocate(ndstk(nr,ideg), iold(nr), perm(nr+1), ndeg(nr),stat=info) + if (info /= 0) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info, name) + goto 9999 + end if + do i=1, nr + iold(i) = i + ndstk(i,:) = 0 + k = 0 + do j=acsr%irp(i),acsr%irp(i+1)-1 + k = k + 1 + ndstk(i,k) = acsr%ja(j) + end do + end do + perm = 0 + + call psb_gps_reduce(ndstk,nr,ideg,iold,perm,ndeg,ibw,ipf,idpth) + + if (.not.psb_isaperm(nr,perm)) then + write(0,*) 'Something wrong: bad perm from gps_reduce' + info = psb_err_from_subroutine_ + call psb_errpush(info,name) + goto 9999 + end if + ! Move to coordinate to apply renumbering + call acsr%mv_to_coo(acoo,info) + do i=1, acoo%get_nzeros() + acoo%ia(i) = perm(acoo%ia(i)) + acoo%ja(i) = perm(acoo%ja(i)) + end do + call acoo%fix(info) + + ! Get back to where we started from + call aa%mv_from_coo(acoo,info) + call a%mv_from(aa) + if (present(operm)) then + call psb_realloc(nr,operm,info) + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + end if + operm(1:nr) = perm(1:nr) + end if + + deallocate(aa) + 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 psb_mat_renum_gps + +end subroutine psb_c_mat_renum + diff --git a/util/psb_d_hbio_impl.f90 b/util/psb_d_hbio_impl.f90 new file mode 100644 index 000000000..b31ed247a --- /dev/null +++ b/util/psb_d_hbio_impl.f90 @@ -0,0 +1,328 @@ +!!$ +!!$ Parallel Sparse BLAS version 3.0 +!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine dhb_read(a, iret, iunit, filename,b,g,x,mtitle) + use psb_base_mod + implicit none + type(psb_dspmat_type), intent(out) :: a + integer, intent(out) :: iret + integer, optional, intent(in) :: iunit + character(len=*), optional, intent(in) :: filename + real(psb_dpk_), optional, allocatable, intent(out) :: b(:,:), g(:,:), x(:,:) + character(len=72), optional, intent(out) :: mtitle + + character :: rhstype*3,type*3,key*8 + character(len=72) :: mtitle_ + character indfmt*16,ptrfmt*16,rhsfmt*20,valfmt*20 + integer :: indcrd, ptrcrd, totcrd,& + & valcrd, rhscrd, nrow, ncol, nnzero, neltvl, nrhs, nrhsix + type(psb_d_csc_sparse_mat) :: acsc + type(psb_d_coo_sparse_mat) :: acoo + integer :: ircode, i,nzr,infile, info + character(len=*), parameter :: fmt10='(a72,a8,/,5i14,/,a3,11x,4i14,/,2a16,2a20)' + character(len=*), parameter :: fmt11='(a3,11x,2i14)' + character(len=*), parameter :: fmt111='(1x,a8,1x,i8,1x,a10)' + + iret = 0 + ircode = 0 + if (present(filename)) then + if (filename == '-') then + infile=5 + else + if (present(iunit)) then + infile=iunit + else + infile=99 + endif + open(infile,file=filename, status='OLD', err=901, action='READ') + endif + else + if (present(iunit)) then + infile=iunit + else + infile=5 + endif + endif + + read (infile,fmt=fmt10) mtitle_,key,totcrd,ptrcrd,indcrd,valcrd,rhscrd,& + & type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt + if (rhscrd > 0) read(infile,fmt=fmt11)rhstype,nrhs,nrhsix + + call acsc%allocate(nrow,ncol,nnzero) + if (ircode /= 0 ) then + write(psb_err_unit,*) 'Memory allocation failed' + goto 993 + end if + + if (present(mtitle)) mtitle=mtitle_ + + + if (psb_tolower(type(1:1)) == 'r') then + if (psb_tolower(type(2:2)) == 'u') then + + + read (infile,fmt=ptrfmt) (acsc%icp(i),i=1,ncol+1) + read (infile,fmt=indfmt) (acsc%ia(i),i=1,nnzero) + if (valcrd > 0) read (infile,fmt=valfmt) (acsc%val(i),i=1,nnzero) + + call a%mv_from(acsc) + + if (present(b)) then + if ((psb_toupper(rhstype(1:1)) == 'F').and.(rhscrd > 0)) then + call psb_realloc(nrow,1,b,info) + read (infile,fmt=rhsfmt) (b(i,1),i=1,nrow) + endif + endif + if (present(g)) then + if ((psb_toupper(rhstype(2:2)) == 'G').and.(rhscrd > 0)) then + call psb_realloc(nrow,1,g,info) + read (infile,fmt=rhsfmt) (g(i,1),i=1,nrow) + endif + endif + if (present(x)) then + if ((psb_toupper(rhstype(3:3)) == 'X').and.(rhscrd > 0)) then + call psb_realloc(nrow,1,x,info) + read (infile,fmt=rhsfmt) (x(i,1),i=1,nrow) + endif + endif + + else if (psb_tolower(type(2:2)) == 's') then + + ! we are generally working with non-symmetric matrices, so + ! we de-symmetrize what we are about to read + + read (infile,fmt=ptrfmt) (acsc%icp(i),i=1,ncol+1) + read (infile,fmt=indfmt) (acsc%ia(i),i=1,nnzero) + if (valcrd > 0) read (infile,fmt=valfmt) (acsc%val(i),i=1,nnzero) + + + if (present(b)) then + if ((psb_toupper(rhstype(1:1)) == 'F').and.(rhscrd > 0)) then + call psb_realloc(nrow,1,b,info) + read (infile,fmt=rhsfmt) (b(i,1),i=1,nrow) + endif + endif + if (present(g)) then + if ((psb_toupper(rhstype(2:2)) == 'G').and.(rhscrd > 0)) then + call psb_realloc(nrow,1,g,info) + read (infile,fmt=rhsfmt) (g(i,1),i=1,nrow) + endif + endif + if (present(x)) then + if ((psb_toupper(rhstype(3:3)) == 'X').and.(rhscrd > 0)) then + call psb_realloc(nrow,1,x,info) + read (infile,fmt=rhsfmt) (x(i,1),i=1,nrow) + endif + endif + + + call acoo%mv_from_fmt(acsc,info) + call acoo%reallocate(2*nnzero) + ! A is now in COO format + nzr = nnzero + do i=1,nnzero + if (acoo%ia(i) /= acoo%ja(i)) then + nzr = nzr + 1 + acoo%val(nzr) = acoo%val(i) + acoo%ia(nzr) = acoo%ja(i) + acoo%ja(nzr) = acoo%ia(i) + end if + end do + call acoo%set_nzeros(nzr) + call acoo%fix(ircode) + if (ircode == 0) call a%mv_from(acoo) + if (ircode /= 0) goto 993 + + else + write(psb_err_unit,*) 'read_matrix: matrix type not yet supported' + iret=904 + end if + else + write(psb_err_unit,*) 'read_matrix: matrix type not yet supported' + iret=904 + end if + + call a%cscnv(ircode,type='csr') + if (infile /= 5) close(infile) + + return + + ! open failed +901 iret=901 + write(psb_err_unit,*) 'read_matrix: could not open file ',filename,' for input' + return +902 iret=902 + write(psb_err_unit,*) 'HB_READ: Unexpected end of file ' + return +993 iret=993 + write(psb_err_unit,*) 'HB_READ: Memory allocation failure' + return +end subroutine dhb_read + +subroutine dhb_write(a,iret,iunit,filename,key,rhs,g,x,mtitle) + use psb_base_mod + implicit none + type(psb_dspmat_type), intent(in), target :: a + integer, intent(out) :: iret + character(len=*), optional, intent(in) :: mtitle + integer, optional, intent(in) :: iunit + character(len=*), optional, intent(in) :: filename + character(len=*), optional, intent(in) :: key + real(psb_dpk_), optional :: rhs(:), g(:), x(:) + integer :: iout + + character(len=*), parameter:: ptrfmt='(10I8)',indfmt='(10I8)' + integer, parameter :: jptr=10,jind=10 + character(len=*), parameter:: valfmt='(4E20.12)',rhsfmt='(4E20.12)' + integer, parameter :: jval=4,jrhs=4 + character(len=*), parameter :: fmt10='(a72,a8,/,5i14,/,a3,11x,4i14,/,2a16,2a20)' + character(len=*), parameter :: fmt11='(a3,11x,2i14)' + character(len=*), parameter :: fmt111='(1x,a8,1x,i8,1x,a10)' + + type(psb_d_csc_sparse_mat), target :: acsc + type(psb_d_csc_sparse_mat), pointer :: acpnt + character(len=72) :: mtitle_ + character(len=8) :: key_ + + character :: rhstype*3,type*3 + + integer :: i,indcrd,ptrcrd,rhscrd,totcrd,valcrd,& + & nrow,ncol,nnzero, neltvl, nrhs, nrhsix + + iret = 0 + + if (present(filename)) then + if (filename == '-') then + iout=6 + else + if (present(iunit)) then + iout = iunit + else + iout=99 + endif + open(iout,file=filename, err=901, action='WRITE') + endif + else + if (present(iunit)) then + iout = iunit + else + iout=6 + endif + endif + + if (present(mtitle)) then + mtitle_ = mtitle + else + mtitle_ = 'Temporary PSBLAS title ' + endif + if (present(key)) then + key_ = key + else + key_ = 'PSBMAT00' + endif + + + select type(aa=>a%a) + type is (psb_d_csc_sparse_mat) + + acpnt => aa + + class default + + call acsc%cp_from_fmt(aa, iret) + if (iret /= 0) return + acpnt => acsc + + end select + + + nrow = acpnt%get_nrows() + ncol = acpnt%get_ncols() + nnzero = acpnt%get_nzeros() + + neltvl = 0 + + ptrcrd = (ncol+1)/jptr + if (mod(ncol+1,jptr) > 0) ptrcrd = ptrcrd + 1 + indcrd = nnzero/jind + if (mod(nnzero,jind) > 0) indcrd = indcrd + 1 + valcrd = nnzero/jval + if (mod(nnzero,jval) > 0) valcrd = valcrd + 1 + rhstype = '' + if (present(rhs)) then + if (size(rhs) 0) rhscrd = rhscrd + 1 + endif + nrhs = 1 + rhstype(1:1) = 'F' + else + rhscrd = 0 + nrhs = 0 + end if + totcrd = ptrcrd + indcrd + valcrd + rhscrd + + nrhsix = nrhs*nrow + + if (present(g)) then + rhstype(2:2) = 'G' + end if + if (present(x)) then + rhstype(3:3) = 'X' + end if + type = 'RUA' + + write (iout,fmt=fmt10) mtitle_,key_,totcrd,ptrcrd,indcrd,valcrd,rhscrd,& + & type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt + if (rhscrd > 0) write (iout,fmt=fmt11) rhstype,nrhs,nrhsix + write (iout,fmt=ptrfmt) (acpnt%icp(i),i=1,ncol+1) + write (iout,fmt=indfmt) (acpnt%ia(i),i=1,nnzero) + if (valcrd > 0) write (iout,fmt=valfmt) (acpnt%val(i),i=1,nnzero) + if (rhscrd > 0) write (iout,fmt=rhsfmt) (rhs(i),i=1,nrow) + if (present(g).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (g(i),i=1,nrow) + if (present(x).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (x(i),i=1,nrow) + + + + + if (iout /= 6) close(iout) + + + return + +901 continue + iret=901 + write(psb_err_unit,*) 'Error while opening ',filename + return +end subroutine dhb_write + diff --git a/util/psb_d_mat_dist_impl.f90 b/util/psb_d_mat_dist_impl.f90 new file mode 100644 index 000000000..503e4e7bf --- /dev/null +++ b/util/psb_d_mat_dist_impl.f90 @@ -0,0 +1,472 @@ +!!$ +!!$ Parallel Sparse BLAS version 3.0 +!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine dmatdist(a_glob, a, ictxt, desc_a,& + & b_glob, b, info, parts, v, inroot,fmt,mold) + ! + ! an utility subroutine to distribute a matrix among processors + ! according to a user defined data distribution, using + ! sparse matrix subroutines. + ! + ! type(d_spmat) :: a_glob + ! on entry: this contains the global sparse matrix as follows: + ! a%fida == 'csr' + ! a%aspk for coefficient values + ! a%ia1 for column indices + ! a%ia2 for row pointers + ! a%m for number of global matrix rows + ! a%k for number of global matrix columns + ! on exit : undefined, with unassociated pointers. + ! + ! type(d_spmat) :: a + ! on entry: fresh variable. + ! on exit : this will contain the local sparse matrix. + ! + ! interface parts + ! ! .....user passed subroutine..... + ! subroutine parts(global_indx,n,np,pv,nv) + ! implicit none + ! integer, intent(in) :: global_indx, n, np + ! integer, intent(out) :: nv + ! integer, intent(out) :: pv(*) + ! + ! end subroutine parts + ! end interface + ! on entry: subroutine providing user defined data distribution. + ! for each global_indx the subroutine should return + ! the list pv of all processes owning the row with + ! that index; the list will contain nv entries. + ! usually nv=1; if nv >1 then we have an overlap in the data + ! distribution. + ! + ! integer :: ictxt + ! on entry: blacs context. + ! on exit : unchanged. + ! + ! type (desc_type) :: desc_a + ! on entry: fresh variable. + ! on exit : the updated array descriptor + ! + ! real(psb_dpk_), optional :: b_glob(:) + ! on entry: this contains right hand side. + ! on exit : + ! + ! real(psb_dpk_), allocatable, optional :: b(:) + ! on entry: fresh variable. + ! on exit : this will contain the local right hand side. + ! + ! integer, optional :: inroot + ! on entry: specifies processor holding a_glob. default: 0 + ! on exit : unchanged. + ! + use psb_base_mod + use psb_mat_mod + implicit none + + ! parameters + type(psb_dspmat_type) :: a_glob + real(psb_dpk_) :: b_glob(:) + integer :: ictxt + type(psb_dspmat_type) :: a + type(psb_d_vect_type) :: b + type(psb_desc_type) :: desc_a + integer, intent(out) :: info + integer, optional :: inroot + character(len=5), optional :: fmt + class(psb_d_base_sparse_mat), optional :: mold + + integer :: v(:) + interface + subroutine parts(global_indx,n,np,pv,nv) + implicit none + integer, intent(in) :: global_indx, n, np + integer, intent(out) :: nv + integer, intent(out) :: pv(*) + end subroutine parts + end interface + optional :: parts, v + + ! local variables + logical :: use_parts, use_v + integer :: np, iam + integer :: length_row, i_count, j_count,& + & k_count, root, liwork, nrow, ncol, nnzero, nrhs,& + & i, ll, nz, isize, iproc, nnr, err, err_act, int_err(5) + integer, allocatable :: iwork(:) + integer, allocatable :: irow(:),icol(:) + real(psb_dpk_), allocatable :: val(:) + integer, parameter :: nb=30 + real(psb_dpk_) :: t0, t1, t2, t3, t4, t5 + character(len=20) :: name, ch_err + + info = psb_success_ + err = 0 + name = 'mat_distf' + call psb_erractionsave(err_act) + + ! executable statements + if (present(inroot)) then + root = inroot + else + root = psb_root_ + end if + call psb_info(ictxt, iam, np) + if (iam == root) then + nrow = a_glob%get_nrows() + ncol = a_glob%get_ncols() + if (nrow /= ncol) then + write(psb_err_unit,*) 'a rectangular matrix ? ',nrow,ncol + info=-1 + call psb_errpush(info,name) + goto 9999 + endif + nnzero = a_glob%get_nzeros() + nrhs = 1 + endif + + use_parts = present(parts) + use_v = present(v) + if (count((/ use_parts, use_v /)) /= 1) then + info=psb_err_no_optional_arg_ + call psb_errpush(info,name,a_err=" v, parts") + goto 9999 + endif + + ! broadcast informations to other processors + call psb_bcast(ictxt,nrow, root) + call psb_bcast(ictxt,ncol, root) + call psb_bcast(ictxt,nnzero, root) + call psb_bcast(ictxt,nrhs, root) + liwork = max(np, nrow + ncol) + allocate(iwork(liwork), stat = info) + if (info /= psb_success_) then + info=psb_err_alloc_request_ + int_err(1)=liwork + call psb_errpush(info,name,i_err=int_err,a_err='integer') + goto 9999 + endif + if (iam == root) then + write (*, fmt = *) 'start matdist',root, size(iwork),& + &nrow, ncol, nnzero,nrhs, use_parts, use_v + endif + if (use_parts) then + call psb_cdall(ictxt,desc_a,info,mg=nrow,parts=parts) + else if (use_v) then + call psb_cdall(ictxt,desc_a,info,vg=v) + else + info = -1 + end if + + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_cdall' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + call psb_spall(a,desc_a,info,nnz=((nnzero+np-1)/np)) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_psspall' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + call psb_geall(b,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_psdsall' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + + + isize = 3*nb*max(((nnzero+nrow)/nrow),nb) + allocate(val(isize),irow(isize),icol(isize),stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='Allocate' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + i_count = 1 + + do while (i_count <= nrow) + + if (use_parts) then + call parts(i_count,nrow,np,iwork, length_row) + if (length_row == 1) then + j_count = i_count + iproc = iwork(1) + do + j_count = j_count + 1 + if (j_count-i_count >= nb) exit + if (j_count > nrow) exit + call parts(j_count,nrow,np,iwork, length_row) + if (length_row /= 1 ) exit + if (iwork(1) /= iproc ) exit + end do + end if + else + length_row = 1 + j_count = i_count + iproc = v(i_count) + + do + j_count = j_count + 1 + if (j_count-i_count >= nb) exit + if (j_count > nrow) exit + if (v(j_count) /= iproc ) exit + end do + end if + + if (length_row == 1) then + ! now we should insert rows i_count..j_count-1 + nnr = j_count - i_count + + if (iam == root) then + + ll = 0 + do i= i_count, j_count-1 + call a_glob%csget(i,i,nz,& + & irow,icol,val,info,nzin=ll,append=.true.) + if (info /= psb_success_) then + if (nz >min(size(irow(ll+1:)),size(icol(ll+1:)),size(val(ll+1:)))) then + write(psb_err_unit,*) 'Allocation failure? This should not happen!' + end if + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + ll = ll + nz + end do +!!$ write(0,*) 'mat_dist: sending rows ',i_count,j_count-1,' to proc',iproc, ll + if (iproc == iam) then + call psb_spins(ll,irow,icol,val,a,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_spins' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + call psb_geins(nnr,(/(i,i=i_count,j_count-1)/),b_glob(i_count:j_count-1),& + & b,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_ins' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + else + call psb_snd(ictxt,nnr,iproc) + call psb_snd(ictxt,ll,iproc) + call psb_snd(ictxt,irow(1:ll),iproc) + call psb_snd(ictxt,icol(1:ll),iproc) + call psb_snd(ictxt,val(1:ll),iproc) + call psb_snd(ictxt,b_glob(i_count:j_count-1),iproc) + call psb_rcv(ictxt,ll,iproc) + endif + else if (iam /= root) then + + if (iproc == iam) then + call psb_rcv(ictxt,nnr,root) + call psb_rcv(ictxt,ll,root) + if (ll > size(irow)) then + write(psb_err_unit,*) iam,'need to reallocate ',ll + deallocate(val,irow,icol) + allocate(val(ll),irow(ll),icol(ll),stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='Allocate' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + endif + call psb_rcv(ictxt,irow(1:ll),root) + call psb_rcv(ictxt,icol(1:ll),root) + call psb_rcv(ictxt,val(1:ll),root) + call psb_rcv(ictxt,b_glob(i_count:i_count+nnr-1),root) + call psb_snd(ictxt,ll,root) + call psb_spins(ll,irow,icol,val,a,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psspins' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + call psb_geins(nnr,(/(i,i=i_count,i_count+nnr-1)/),& + & b_glob(i_count:i_count+nnr-1),b,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psdsins' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + endif + endif + + i_count = j_count + + else + + ! here processors are counted 1..np + do j_count = 1, length_row + k_count = iwork(j_count) + if (iam == root) then + + ll = 0 + do i= i_count, i_count + call a_glob%csget(i,i,nz,& + & irow,icol,val,info,nzin=ll,append=.true.) + if (info /= psb_success_) then + if (nz >min(size(irow(ll+1:)),size(icol(ll+1:)),size(val(ll+1:)))) then + write(psb_err_unit,*) 'Allocation failure? This should not happen!' + end if + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + ll = ll + nz + end do + + if (k_count == iam) then + + call psb_spins(ll,irow,icol,val,a,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psspins' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + call psb_geins(1,(/i_count/),b_glob(i_count:i_count),& + & b,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psdsins' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + else + call psb_snd(ictxt,ll,k_count) + call psb_snd(ictxt,irow(1:ll),k_count) + call psb_snd(ictxt,icol(1:ll),k_count) + call psb_snd(ictxt,val(1:ll),k_count) + call psb_snd(ictxt,b_glob(i_count),k_count) + call psb_rcv(ictxt,ll,k_count) + endif + else if (iam /= root) then + if (k_count == iam) then + call psb_rcv(ictxt,ll,root) + call psb_rcv(ictxt,irow(1:ll),root) + call psb_rcv(ictxt,icol(1:ll),root) + call psb_rcv(ictxt,val(1:ll),root) + call psb_rcv(ictxt,b_glob(i_count),root) + call psb_snd(ictxt,ll,root) + call psb_spins(ll,irow,icol,val,a,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psspins' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + call psb_geins(1,(/i_count/),b_glob(i_count:i_count),& + & b,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psdsins' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + endif + endif + end do + i_count = i_count + 1 + endif + end do + + + call psb_barrier(ictxt) + t0 = psb_wtime() + call psb_cdasb(desc_a,info) + t1 = psb_wtime() + if(info /= psb_success_)then + info=psb_err_from_subroutine_ + ch_err='psb_cdasb' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + call psb_barrier(ictxt) + t2 = psb_wtime() + call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=fmt,mold=mold) + t3 = psb_wtime() + if(info /= psb_success_)then + info=psb_err_from_subroutine_ + ch_err='psb_spasb' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + + if (iam == root) then + write(psb_out_unit,*) 'descriptor assembly: ',t1-t0 + write(psb_out_unit,*) 'sparse matrix assembly: ',t3-t2 + end if + + call psb_geasb(b,desc_a,info) + if(info /= psb_success_)then + info=psb_err_from_subroutine_ + ch_err='psdsasb' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + deallocate(val,irow,icol,stat=info) + if(info /= psb_success_)then + info=psb_err_from_subroutine_ + ch_err='deallocate' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + deallocate(iwork) + if (iam == root) write (*, fmt = *) 'end matdist' + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end subroutine dmatdist diff --git a/util/psb_d_mmio_impl.f90 b/util/psb_d_mmio_impl.f90 new file mode 100644 index 000000000..e835fcb44 --- /dev/null +++ b/util/psb_d_mmio_impl.f90 @@ -0,0 +1,362 @@ +!!$ +!!$ Parallel Sparse BLAS version 3.0 +!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine mm_dvet_read(b, info, iunit, filename) + use psb_base_mod + implicit none + real(psb_dpk_), allocatable, intent(out) :: b(:,:) + integer, intent(out) :: info + integer, optional, intent(in) :: iunit + character(len=*), optional, intent(in) :: filename + integer :: nrow, ncol, i,root, np, me, ircode, j, infile + character :: mmheader*15, fmt*15, object*10, type*10, sym*15,& + & line*1024 + + info = psb_success_ + if (present(filename)) then + if (filename == '-') then + infile=5 + else + if (present(iunit)) then + infile=iunit + else + infile=99 + endif + open(infile,file=filename, status='OLD', err=901, action='READ') + endif + else + if (present(iunit)) then + infile=iunit + else + infile=5 + endif + endif + + read(infile,fmt=*, end=902) mmheader, object, fmt, type, sym + + if ( (object /= 'matrix').or.(fmt /= 'array')) then + write(psb_err_unit,*) 'read_rhs: input file type not yet supported' + info = -3 + return + end if + + do + read(infile,fmt='(a)') line + if (line(1:1) /= '%') exit + end do + + read(line,fmt=*)nrow,ncol + + if ((psb_tolower(type) == 'real').and.(psb_tolower(sym) == 'general')) then + allocate(b(nrow,ncol),stat = ircode) + if (ircode /= 0) goto 993 + read(infile,fmt=*,end=902) ((b(i,j), i=1,nrow),j=1,ncol) + + end if ! read right hand sides + if (infile /= 5) close(infile) + + return + ! open failed +901 write(psb_err_unit,*) 'mm_vet_read: could not open file ',& + & infile,' for input' + info = -1 + return + +902 write(psb_err_unit,*) 'mmv_vet_read: unexpected end of file ',infile,& + & ' during input' + info = -2 + return +993 write(psb_err_unit,*) 'mm_vet_read: memory allocation failure' + info = -3 + return +end subroutine mm_dvet_read +subroutine mm_dvet2_write(b, header, info, iunit, filename) + use psb_base_mod + implicit none + real(psb_dpk_), intent(in) :: b(:,:) + character(len=*), intent(in) :: header + integer, intent(out) :: info + integer, optional, intent(in) :: iunit + character(len=*), optional, intent(in) :: filename + integer :: nrow, ncol, i,root, np, me, ircode, j, outfile + + character(len=80) :: frmtv + + info = psb_success_ + if (present(filename)) then + if (filename == '-') then + outfile=6 + else + if (present(iunit)) then + outfile=iunit + else + outfile=99 + endif + open(outfile,file=filename, err=901, action='WRITE') + endif + else + if (present(iunit)) then + outfile=iunit + else + outfile=6 + endif + endif + + write(outfile,'(a)') '%%MatrixMarket matrix array real general' + write(outfile,'(a)') '% '//trim(header) + write(outfile,'(a)') '% ' + nrow = size(b,1) + ncol = size(b,2) + write(outfile,*) nrow,ncol + + write(frmtv,'(a,i3.3,a)') '(',ncol,'(es26.18,1x))' + + do i=1,size(b,1) + write(outfile,frmtv) b(i,1:ncol) + end do + + if (outfile /= 6) close(outfile) + + return + ! open failed +901 write(psb_err_unit,*) 'mm_vet_write: could not open file ',& + & outfile,' for output' + info = -1 + return + +end subroutine mm_dvet2_write + +subroutine mm_dvet1_write(b, header, info, iunit, filename) + use psb_base_mod + implicit none + real(psb_dpk_), intent(in) :: b(:) + character(len=*), intent(in) :: header + integer, intent(out) :: info + integer, optional, intent(in) :: iunit + character(len=*), optional, intent(in) :: filename + integer :: nrow, ncol, i,root, np, me, ircode, j, outfile + + character(len=80) :: frmtv + + info = psb_success_ + if (present(filename)) then + if (filename == '-') then + outfile=6 + else + if (present(iunit)) then + outfile=iunit + else + outfile=99 + endif + open(outfile,file=filename, err=901, action='WRITE') + endif + else + if (present(iunit)) then + outfile=iunit + else + outfile=6 + endif + endif + + write(outfile,'(a)') '%%MatrixMarket matrix array real general' + write(outfile,'(a)') '% '//trim(header) + write(outfile,'(a)') '% ' + nrow = size(b,1) + ncol = 1 + write(outfile,*) nrow,ncol + + write(frmtv,'(a,i3.3,a)') '(',ncol,'(es26.18,1x))' + + do i=1,size(b,1) + write(outfile,frmtv) b(i) + end do + + if (outfile /= 6) close(outfile) + + return + ! open failed +901 write(psb_err_unit,*) 'mm_vet_write: could not open file ',& + & outfile,' for output' + info = -1 + return + +end subroutine mm_dvet1_write + +subroutine dmm_mat_read(a, info, iunit, filename) + use psb_base_mod + implicit none + type(psb_dspmat_type), intent(out) :: a + integer, intent(out) :: info + integer, optional, intent(in) :: iunit + character(len=*), optional, intent(in) :: filename + character :: mmheader*15, fmt*15, object*10, type*10, sym*15 + character(1024) :: line + integer :: nrow, ncol, nnzero + integer :: ircode, i,nzr,infile + type(psb_d_coo_sparse_mat), allocatable :: acoo + + info = psb_success_ + + if (present(filename)) then + if (filename == '-') then + infile=5 + else + if (present(iunit)) then + infile=iunit + else + infile=99 + endif + open(infile,file=filename, status='OLD', err=901, action='READ') + endif + else + if (present(iunit)) then + infile=iunit + else + infile=5 + endif + endif + + read(infile,fmt=*,end=902) mmheader, object, fmt, type, sym + + if ( (psb_tolower(object) /= 'matrix').or.(psb_tolower(fmt) /= 'coordinate')) then + write(psb_err_unit,*) 'READ_MATRIX: input file type not yet supported' + info=909 + return + end if + + do + read(infile,fmt='(a)') line + if (line(1:1) /= '%') exit + end do + read(line,fmt=*) nrow,ncol,nnzero + + allocate(acoo, stat=ircode) + if (ircode /= 0) goto 993 + if ((psb_tolower(type) == 'real').and.(psb_tolower(sym) == 'general')) then + call acoo%allocate(nrow,ncol,nnzero) + do i=1,nnzero + read(infile,fmt=*,end=902,err=905) acoo%ia(i),acoo%ja(i),acoo%val(i) + end do + call acoo%set_nzeros(nnzero) + call acoo%fix(info) + + call a%mv_from(acoo) + call a%cscnv(ircode,type='csr') + + else if ((psb_tolower(type) == 'real').and.(psb_tolower(sym) == 'symmetric')) then + ! we are generally working with non-symmetric matrices, so + ! we de-symmetrize what we are about to read + call acoo%allocate(nrow,ncol,2*nnzero) + do i=1,nnzero + read(infile,fmt=*,end=902) acoo%ia(i),acoo%ja(i),acoo%val(i) + end do + nzr = nnzero + do i=1,nnzero + if (acoo%ia(i) /= acoo%ja(i)) then + nzr = nzr + 1 + acoo%val(nzr) = acoo%val(i) + acoo%ia(nzr) = acoo%ja(i) + acoo%ja(nzr) = acoo%ia(i) + end if + end do + call acoo%set_nzeros(nzr) + call acoo%fix(info) + + call a%mv_from(acoo) + call a%cscnv(ircode,type='csr') + + else + write(psb_err_unit,*) 'read_matrix: matrix type not yet supported' + info=904 + end if + if (infile /= 5) close(infile) + return + + ! open failed +901 info=901 + write(psb_err_unit,*) 'read_matrix: could not open file ',filename,' for input' + return +902 info=902 + write(psb_err_unit,*) 'READ_MATRIX: Unexpected end of file ' + return +905 info=905 + write(psb_err_unit,*) 'READ_MATRIX: Error at line',i + return +993 info=993 + write(psb_err_unit,*) 'READ_MATRIX: Memory allocation failure' + return +end subroutine dmm_mat_read + + +subroutine dmm_mat_write(a,mtitle,info,iunit,filename) + use psb_base_mod + implicit none + type(psb_dspmat_type), intent(in) :: a + integer, intent(out) :: info + character(len=*), intent(in) :: mtitle + integer, optional, intent(in) :: iunit + character(len=*), optional, intent(in) :: filename + integer :: iout + + + info = psb_success_ + + if (present(filename)) then + if (filename == '-') then + iout=6 + else + if (present(iunit)) then + iout = iunit + else + iout=99 + endif + open(iout,file=filename, err=901, action='WRITE') + endif + else + if (present(iunit)) then + iout = iunit + else + iout=6 + endif + endif + + call a%print(iout,head=mtitle) + + if (iout /= 6) close(iout) + + + return + +901 continue + info=901 + write(psb_err_unit,*) 'Error while opening ',filename + return +end subroutine dmm_mat_write diff --git a/util/psb_d_renum_impl.F90 b/util/psb_d_renum_impl.F90 new file mode 100644 index 000000000..f5b0b3a23 --- /dev/null +++ b/util/psb_d_renum_impl.F90 @@ -0,0 +1,192 @@ +subroutine psb_d_mat_renum(alg,mat,info,perm) + use psb_base_mod + use psb_renum_mod, psb_protect_name => psb_d_mat_renum + implicit none + integer, intent(in) :: alg + type(psb_dspmat_type), intent(inout) :: mat + integer, intent(out) :: info + integer, allocatable, optional, intent(out) :: perm(:) + + integer :: err_act + character(len=20) :: name + + info = psb_success_ + name = 'mat_renum' + call psb_erractionsave(err_act) + + info = psb_success_ + + select case (alg) + case(psb_mat_renum_gps_) + + call psb_mat_renum_gps(mat,info,perm) + + case default + info = psb_err_input_value_invalid_i_ + call psb_errpush(info,name,i_err=(/1,alg,0,0,0/)) + goto 9999 + end select + + if (info /= psb_success_) then + info = psb_err_from_subroutine_non_ + 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 psb_mat_renum_gps(a,info,operm) + use psb_base_mod + use psb_gps_mod + implicit none + type(psb_dspmat_type), intent(inout) :: a + integer, intent(out) :: info + integer, allocatable, optional, intent(out) :: operm(:) + + ! + class(psb_d_base_sparse_mat), allocatable :: aa + type(psb_d_csr_sparse_mat) :: acsr + type(psb_d_coo_sparse_mat) :: acoo + + integer :: err_act + character(len=20) :: name + integer, allocatable :: ndstk(:,:), iold(:), ndeg(:), perm(:) + integer :: i, j, k, ideg, nr, ibw, ipf, idpth + + info = psb_success_ + name = 'mat_renum' + call psb_erractionsave(err_act) + + info = psb_success_ + + call a%mold(aa) + call a%mv_to(aa) + call aa%mv_to_fmt(acsr,info) + ! Insert call to gps_reduce + nr = acsr%get_nrows() + ideg = 0 + do i=1, nr + ideg = max(ideg,acsr%irp(i+1)-acsr%irp(i)) + end do + allocate(ndstk(nr,ideg), iold(nr), perm(nr+1), ndeg(nr),stat=info) + if (info /= 0) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info, name) + goto 9999 + end if + do i=1, nr + iold(i) = i + ndstk(i,:) = 0 + k = 0 + do j=acsr%irp(i),acsr%irp(i+1)-1 + k = k + 1 + ndstk(i,k) = acsr%ja(j) + end do + end do + perm = 0 + + call psb_gps_reduce(ndstk,nr,ideg,iold,perm,ndeg,ibw,ipf,idpth) + + if (.not.psb_isaperm(nr,perm)) then + write(0,*) 'Something wrong: bad perm from gps_reduce' + info = psb_err_from_subroutine_ + call psb_errpush(info,name) + goto 9999 + end if + ! Move to coordinate to apply renumbering + call acsr%mv_to_coo(acoo,info) + do i=1, acoo%get_nzeros() + acoo%ia(i) = perm(acoo%ia(i)) + acoo%ja(i) = perm(acoo%ja(i)) + end do + call acoo%fix(info) + + ! Get back to where we started from + call aa%mv_from_coo(acoo,info) + call a%mv_from(aa) + if (present(operm)) then + call psb_realloc(nr,operm,info) + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + end if + operm(1:nr) = perm(1:nr) + end if + + deallocate(aa) + 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 psb_mat_renum_gps + +end subroutine psb_d_mat_renum + + +subroutine psb_d_cmp_bwpf(mat,bwl,bwu,prf,info) + use psb_base_mod + use psb_renum_mod, psb_protect_name => psb_d_cmp_bwpf + implicit none + type(psb_dspmat_type), intent(in) :: mat + integer, intent(out) :: bwl, bwu + integer, intent(out) :: prf + integer, intent(out) :: info + ! + integer, allocatable :: irow(:), icol(:) + real(psb_dpk_), allocatable :: val(:) + integer :: nz + integer :: i, j, lrbu, lrbl + + info = psb_success_ + bwl = 0 + bwu = 0 + prf = 0 + select type (aa=>mat%a) + class is (psb_d_csr_sparse_mat) + do i=1, aa%get_nrows() + lrbl = 0 + lrbu = 0 + do j = aa%irp(i), aa%irp(i+1) - 1 + lrbl = max(lrbl,i-aa%ja(j)) + lrbu = max(lrbu,aa%ja(j)-i) + end do + prf = prf + lrbl+lrbu + bwu = max(bwu,lrbu) + bwl = max(bwl,lrbu) + end do + + class default + do i=1, aa%get_nrows() + lrbl = 0 + lrbu = 0 + call aa%csget(i,i,nz,irow,icol,val,info) + if (info /= psb_success_) return + do j=1, nz + lrbl = max(lrbl,i-icol(j)) + lrbu = max(lrbu,icol(j)-i) + end do + prf = prf + lrbl+lrbu + bwu = max(bwu,lrbu) + bwl = max(bwl,lrbu) + end do + end select + +end subroutine psb_d_cmp_bwpf diff --git a/util/psb_hbio_impl.f90 b/util/psb_hbio_impl.f90 deleted file mode 100644 index 89de8193a..000000000 --- a/util/psb_hbio_impl.f90 +++ /dev/null @@ -1,1320 +0,0 @@ -!!$ -!!$ Parallel Sparse BLAS version 3.0 -!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 -!!$ Salvatore Filippone University of Rome Tor Vergata -!!$ Alfredo Buttari CNRS-IRIT, Toulouse -!!$ -!!$ Redistribution and use in source and binary forms, with or without -!!$ modification, are permitted provided that the following conditions -!!$ are met: -!!$ 1. Redistributions of source code must retain the above copyright -!!$ notice, this list of conditions and the following disclaimer. -!!$ 2. Redistributions in binary form must reproduce the above copyright -!!$ notice, this list of conditions, and the following disclaimer in the -!!$ documentation and/or other materials provided with the distribution. -!!$ 3. The name of the PSBLAS group or the names of its contributors may -!!$ not be used to endorse or promote products derived from this -!!$ software without specific written permission. -!!$ -!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS -!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -!!$ POSSIBILITY OF SUCH DAMAGE. -!!$ -!!$ -subroutine shb_read(a, iret, iunit, filename,b,g,x,mtitle) - use psb_base_mod - implicit none - type(psb_sspmat_type), intent(out) :: a - integer, intent(out) :: iret - integer, optional, intent(in) :: iunit - character(len=*), optional, intent(in) :: filename - real(psb_spk_), optional, allocatable, intent(out) :: b(:,:), g(:,:), x(:,:) - character(len=72), optional, intent(out) :: mtitle - - character :: rhstype*3,type*3,key*8 - character(len=72) :: mtitle_ - character indfmt*16,ptrfmt*16,rhsfmt*20,valfmt*20 - integer :: indcrd, ptrcrd, totcrd,& - & valcrd, rhscrd, nrow, ncol, nnzero, neltvl, nrhs, nrhsix - type(psb_s_csc_sparse_mat) :: acsc - type(psb_s_coo_sparse_mat) :: acoo - integer :: ircode, i,nzr,infile, info - character(len=*), parameter :: fmt10='(a72,a8,/,5i14,/,a3,11x,4i14,/,2a16,2a20)' - character(len=*), parameter :: fmt11='(a3,11x,2i14)' - character(len=*), parameter :: fmt111='(1x,a8,1x,i8,1x,a10)' - - iret = 0 - - if (present(filename)) then - if (filename == '-') then - infile=5 - else - if (present(iunit)) then - infile=iunit - else - infile=99 - endif - open(infile,file=filename, status='OLD', err=901, action='READ') - endif - else - if (present(iunit)) then - infile=iunit - else - infile=5 - endif - endif - - read (infile,fmt=fmt10) mtitle_,key,totcrd,ptrcrd,indcrd,valcrd,rhscrd,& - & type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt - if (rhscrd > 0) read(infile,fmt=fmt11)rhstype,nrhs,nrhsix - - call acsc%allocate(nrow,ncol,nnzero) - if (ircode /= 0 ) then - write(psb_err_unit,*) 'Memory allocation failed' - goto 993 - end if - - if (present(mtitle)) mtitle=mtitle_ - - - if (psb_tolower(type(1:1)) == 'r') then - if (psb_tolower(type(2:2)) == 'u') then - - - read (infile,fmt=ptrfmt) (acsc%icp(i),i=1,ncol+1) - read (infile,fmt=indfmt) (acsc%ia(i),i=1,nnzero) - if (valcrd > 0) read (infile,fmt=valfmt) (acsc%val(i),i=1,nnzero) - - call a%mv_from(acsc) - - if (present(b)) then - if ((psb_toupper(rhstype(1:1)) == 'F').and.(rhscrd > 0)) then - call psb_realloc(nrow,1,b,info) - read (infile,fmt=rhsfmt) (b(i,1),i=1,nrow) - endif - endif - if (present(g)) then - if ((psb_toupper(rhstype(2:2)) == 'G').and.(rhscrd > 0)) then - call psb_realloc(nrow,1,g,info) - read (infile,fmt=rhsfmt) (g(i,1),i=1,nrow) - endif - endif - if (present(x)) then - if ((psb_toupper(rhstype(3:3)) == 'X').and.(rhscrd > 0)) then - call psb_realloc(nrow,1,x,info) - read (infile,fmt=rhsfmt) (x(i,1),i=1,nrow) - endif - endif - - else if (psb_tolower(type(2:2)) == 's') then - - ! we are generally working with non-symmetric matrices, so - ! we de-symmetrize what we are about to read - - read (infile,fmt=ptrfmt) (acsc%icp(i),i=1,ncol+1) - read (infile,fmt=indfmt) (acsc%ia(i),i=1,nnzero) - if (valcrd > 0) read (infile,fmt=valfmt) (acsc%val(i),i=1,nnzero) - - - if (present(b)) then - if ((psb_toupper(rhstype(1:1)) == 'F').and.(rhscrd > 0)) then - call psb_realloc(nrow,1,b,info) - read (infile,fmt=rhsfmt) (b(i,1),i=1,nrow) - endif - endif - if (present(g)) then - if ((psb_toupper(rhstype(2:2)) == 'G').and.(rhscrd > 0)) then - call psb_realloc(nrow,1,g,info) - read (infile,fmt=rhsfmt) (g(i,1),i=1,nrow) - endif - endif - if (present(x)) then - if ((psb_toupper(rhstype(3:3)) == 'X').and.(rhscrd > 0)) then - call psb_realloc(nrow,1,x,info) - read (infile,fmt=rhsfmt) (x(i,1),i=1,nrow) - endif - endif - - - call acoo%mv_from_fmt(acsc,info) - call acoo%reallocate(2*nnzero) - ! A is now in COO format - nzr = nnzero - do i=1,nnzero - if (acoo%ia(i) /= acoo%ja(i)) then - nzr = nzr + 1 - acoo%val(nzr) = acoo%val(i) - acoo%ia(nzr) = acoo%ja(i) - acoo%ja(nzr) = acoo%ia(i) - end if - end do - call acoo%set_nzeros(nzr) - call acoo%fix(ircode) - if (ircode == 0) call a%mv_from(acoo) - if (ircode /= 0) goto 993 - - else - write(psb_err_unit,*) 'read_matrix: matrix type not yet supported' - iret=904 - end if - else - write(psb_err_unit,*) 'read_matrix: matrix type not yet supported' - iret=904 - end if - - call a%cscnv(ircode,type='csr') - if (infile /= 5) close(infile) - - return - - ! open failed -901 iret=901 - write(psb_err_unit,*) 'read_matrix: could not open file ',filename,' for input' - return -902 iret=902 - write(psb_err_unit,*) 'HB_READ: Unexpected end of file ' - return -993 iret=993 - write(psb_err_unit,*) 'HB_READ: Memory allocation failure' - return -end subroutine shb_read - -subroutine shb_write(a,iret,iunit,filename,key,rhs,g,x,mtitle) - use psb_base_mod - implicit none - type(psb_sspmat_type), intent(in), target :: a - integer, intent(out) :: iret - character(len=*), optional, intent(in) :: mtitle - integer, optional, intent(in) :: iunit - character(len=*), optional, intent(in) :: filename - character(len=*), optional, intent(in) :: key - real(psb_spk_), optional :: rhs(:), g(:), x(:) - integer :: iout - - character(len=*), parameter:: ptrfmt='(10I8)',indfmt='(10I8)' - integer, parameter :: jptr=10,jind=10 - character(len=*), parameter:: valfmt='(4E20.12)',rhsfmt='(4E20.12)' - integer, parameter :: jval=4,jrhs=4 - character(len=*), parameter :: fmt10='(a72,a8,/,5i14,/,a3,11x,4i14,/,2a16,2a20)' - character(len=*), parameter :: fmt11='(a3,11x,2i14)' - character(len=*), parameter :: fmt111='(1x,a8,1x,i8,1x,a10)' - - type(psb_s_csc_sparse_mat), target :: acsc - type(psb_s_csc_sparse_mat), pointer :: acpnt - character(len=72) :: mtitle_ - character(len=8) :: key_ - - character :: rhstype*3,type*3 - - integer :: i,indcrd,ptrcrd,rhscrd,totcrd,valcrd,& - & nrow,ncol,nnzero, neltvl, nrhs, nrhsix - - iret = 0 - - if (present(filename)) then - if (filename == '-') then - iout=6 - else - if (present(iunit)) then - iout = iunit - else - iout=99 - endif - open(iout,file=filename, err=901, action='WRITE') - endif - else - if (present(iunit)) then - iout = iunit - else - iout=6 - endif - endif - - if (present(mtitle)) then - mtitle_ = mtitle - else - mtitle_ = 'Temporary PSBLAS title ' - endif - if (present(key)) then - key_ = key - else - key_ = 'PSBMAT00' - endif - - - select type(aa=>a%a) - type is (psb_s_csc_sparse_mat) - - acpnt => aa - - class default - - call acsc%cp_from_fmt(aa, iret) - if (iret /= 0) return - acpnt => acsc - - end select - - - nrow = acpnt%get_nrows() - ncol = acpnt%get_ncols() - nnzero = acpnt%get_nzeros() - - neltvl = 0 - - ptrcrd = (ncol+1)/jptr - if (mod(ncol+1,jptr) > 0) ptrcrd = ptrcrd + 1 - indcrd = nnzero/jind - if (mod(nnzero,jind) > 0) indcrd = indcrd + 1 - valcrd = nnzero/jval - if (mod(nnzero,jval) > 0) valcrd = valcrd + 1 - rhstype = '' - if (present(rhs)) then - if (size(rhs) 0) rhscrd = rhscrd + 1 - endif - nrhs = 1 - rhstype(1:1) = 'F' - else - rhscrd = 0 - nrhs = 0 - end if - totcrd = ptrcrd + indcrd + valcrd + rhscrd - - nrhsix = nrhs*nrow - - if (present(g)) then - rhstype(2:2) = 'G' - end if - if (present(x)) then - rhstype(3:3) = 'X' - end if - type = 'RUA' - - write (iout,fmt=fmt10) mtitle_,key_,totcrd,ptrcrd,indcrd,valcrd,rhscrd,& - & type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt - if (rhscrd > 0) write (iout,fmt=fmt11) rhstype,nrhs,nrhsix - write (iout,fmt=ptrfmt) (acpnt%icp(i),i=1,ncol+1) - write (iout,fmt=indfmt) (acpnt%ia(i),i=1,nnzero) - if (valcrd > 0) write (iout,fmt=valfmt) (acpnt%val(i),i=1,nnzero) - if (rhscrd > 0) write (iout,fmt=rhsfmt) (rhs(i),i=1,nrow) - if (present(g).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (g(i),i=1,nrow) - if (present(x).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (x(i),i=1,nrow) - - - - - if (iout /= 6) close(iout) - - - return - -901 continue - iret=901 - write(psb_err_unit,*) 'Error while opening ',filename - return -end subroutine shb_write - - - -subroutine dhb_read(a, iret, iunit, filename,b,g,x,mtitle) - use psb_base_mod - implicit none - type(psb_dspmat_type), intent(out) :: a - integer, intent(out) :: iret - integer, optional, intent(in) :: iunit - character(len=*), optional, intent(in) :: filename - real(psb_dpk_), optional, allocatable, intent(out) :: b(:,:), g(:,:), x(:,:) - character(len=72), optional, intent(out) :: mtitle - - character :: rhstype*3,type*3,key*8 - character(len=72) :: mtitle_ - character indfmt*16,ptrfmt*16,rhsfmt*20,valfmt*20 - integer :: indcrd, ptrcrd, totcrd,& - & valcrd, rhscrd, nrow, ncol, nnzero, neltvl, nrhs, nrhsix - type(psb_d_csc_sparse_mat) :: acsc - type(psb_d_coo_sparse_mat) :: acoo - integer :: ircode, i,nzr,infile, info - character(len=*), parameter :: fmt10='(a72,a8,/,5i14,/,a3,11x,4i14,/,2a16,2a20)' - character(len=*), parameter :: fmt11='(a3,11x,2i14)' - character(len=*), parameter :: fmt111='(1x,a8,1x,i8,1x,a10)' - - iret = 0 - - if (present(filename)) then - if (filename == '-') then - infile=5 - else - if (present(iunit)) then - infile=iunit - else - infile=99 - endif - open(infile,file=filename, status='OLD', err=901, action='READ') - endif - else - if (present(iunit)) then - infile=iunit - else - infile=5 - endif - endif - - read (infile,fmt=fmt10) mtitle_,key,totcrd,ptrcrd,indcrd,valcrd,rhscrd,& - & type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt - if (rhscrd > 0) read(infile,fmt=fmt11)rhstype,nrhs,nrhsix - - call acsc%allocate(nrow,ncol,nnzero) - if (ircode /= 0 ) then - write(psb_err_unit,*) 'Memory allocation failed' - goto 993 - end if - - if (present(mtitle)) mtitle=mtitle_ - - - if (psb_tolower(type(1:1)) == 'r') then - if (psb_tolower(type(2:2)) == 'u') then - - - read (infile,fmt=ptrfmt) (acsc%icp(i),i=1,ncol+1) - read (infile,fmt=indfmt) (acsc%ia(i),i=1,nnzero) - if (valcrd > 0) read (infile,fmt=valfmt) (acsc%val(i),i=1,nnzero) - - call a%mv_from(acsc) - - if (present(b)) then - if ((psb_toupper(rhstype(1:1)) == 'F').and.(rhscrd > 0)) then - call psb_realloc(nrow,1,b,info) - read (infile,fmt=rhsfmt) (b(i,1),i=1,nrow) - endif - endif - if (present(g)) then - if ((psb_toupper(rhstype(2:2)) == 'G').and.(rhscrd > 0)) then - call psb_realloc(nrow,1,g,info) - read (infile,fmt=rhsfmt) (g(i,1),i=1,nrow) - endif - endif - if (present(x)) then - if ((psb_toupper(rhstype(3:3)) == 'X').and.(rhscrd > 0)) then - call psb_realloc(nrow,1,x,info) - read (infile,fmt=rhsfmt) (x(i,1),i=1,nrow) - endif - endif - - else if (psb_tolower(type(2:2)) == 's') then - - ! we are generally working with non-symmetric matrices, so - ! we de-symmetrize what we are about to read - - read (infile,fmt=ptrfmt) (acsc%icp(i),i=1,ncol+1) - read (infile,fmt=indfmt) (acsc%ia(i),i=1,nnzero) - if (valcrd > 0) read (infile,fmt=valfmt) (acsc%val(i),i=1,nnzero) - - - if (present(b)) then - if ((psb_toupper(rhstype(1:1)) == 'F').and.(rhscrd > 0)) then - call psb_realloc(nrow,1,b,info) - read (infile,fmt=rhsfmt) (b(i,1),i=1,nrow) - endif - endif - if (present(g)) then - if ((psb_toupper(rhstype(2:2)) == 'G').and.(rhscrd > 0)) then - call psb_realloc(nrow,1,g,info) - read (infile,fmt=rhsfmt) (g(i,1),i=1,nrow) - endif - endif - if (present(x)) then - if ((psb_toupper(rhstype(3:3)) == 'X').and.(rhscrd > 0)) then - call psb_realloc(nrow,1,x,info) - read (infile,fmt=rhsfmt) (x(i,1),i=1,nrow) - endif - endif - - - call acoo%mv_from_fmt(acsc,info) - call acoo%reallocate(2*nnzero) - ! A is now in COO format - nzr = nnzero - do i=1,nnzero - if (acoo%ia(i) /= acoo%ja(i)) then - nzr = nzr + 1 - acoo%val(nzr) = acoo%val(i) - acoo%ia(nzr) = acoo%ja(i) - acoo%ja(nzr) = acoo%ia(i) - end if - end do - call acoo%set_nzeros(nzr) - call acoo%fix(ircode) - if (ircode == 0) call a%mv_from(acoo) - if (ircode /= 0) goto 993 - - else - write(psb_err_unit,*) 'read_matrix: matrix type not yet supported' - iret=904 - end if - else - write(psb_err_unit,*) 'read_matrix: matrix type not yet supported' - iret=904 - end if - - call a%cscnv(ircode,type='csr') - if (infile /= 5) close(infile) - - return - - ! open failed -901 iret=901 - write(psb_err_unit,*) 'read_matrix: could not open file ',filename,' for input' - return -902 iret=902 - write(psb_err_unit,*) 'HB_READ: Unexpected end of file ' - return -993 iret=993 - write(psb_err_unit,*) 'HB_READ: Memory allocation failure' - return -end subroutine dhb_read - -subroutine dhb_write(a,iret,iunit,filename,key,rhs,g,x,mtitle) - use psb_base_mod - implicit none - type(psb_dspmat_type), intent(in), target :: a - integer, intent(out) :: iret - character(len=*), optional, intent(in) :: mtitle - integer, optional, intent(in) :: iunit - character(len=*), optional, intent(in) :: filename - character(len=*), optional, intent(in) :: key - real(psb_dpk_), optional :: rhs(:), g(:), x(:) - integer :: iout - - character(len=*), parameter:: ptrfmt='(10I8)',indfmt='(10I8)' - integer, parameter :: jptr=10,jind=10 - character(len=*), parameter:: valfmt='(4E20.12)',rhsfmt='(4E20.12)' - integer, parameter :: jval=4,jrhs=4 - character(len=*), parameter :: fmt10='(a72,a8,/,5i14,/,a3,11x,4i14,/,2a16,2a20)' - character(len=*), parameter :: fmt11='(a3,11x,2i14)' - character(len=*), parameter :: fmt111='(1x,a8,1x,i8,1x,a10)' - - type(psb_d_csc_sparse_mat), target :: acsc - type(psb_d_csc_sparse_mat), pointer :: acpnt - character(len=72) :: mtitle_ - character(len=8) :: key_ - - character :: rhstype*3,type*3 - - integer :: i,indcrd,ptrcrd,rhscrd,totcrd,valcrd,& - & nrow,ncol,nnzero, neltvl, nrhs, nrhsix - - iret = 0 - - if (present(filename)) then - if (filename == '-') then - iout=6 - else - if (present(iunit)) then - iout = iunit - else - iout=99 - endif - open(iout,file=filename, err=901, action='WRITE') - endif - else - if (present(iunit)) then - iout = iunit - else - iout=6 - endif - endif - - if (present(mtitle)) then - mtitle_ = mtitle - else - mtitle_ = 'Temporary PSBLAS title ' - endif - if (present(key)) then - key_ = key - else - key_ = 'PSBMAT00' - endif - - - select type(aa=>a%a) - type is (psb_d_csc_sparse_mat) - - acpnt => aa - - class default - - call acsc%cp_from_fmt(aa, iret) - if (iret /= 0) return - acpnt => acsc - - end select - - - nrow = acpnt%get_nrows() - ncol = acpnt%get_ncols() - nnzero = acpnt%get_nzeros() - - neltvl = 0 - - ptrcrd = (ncol+1)/jptr - if (mod(ncol+1,jptr) > 0) ptrcrd = ptrcrd + 1 - indcrd = nnzero/jind - if (mod(nnzero,jind) > 0) indcrd = indcrd + 1 - valcrd = nnzero/jval - if (mod(nnzero,jval) > 0) valcrd = valcrd + 1 - rhstype = '' - if (present(rhs)) then - if (size(rhs) 0) rhscrd = rhscrd + 1 - endif - nrhs = 1 - rhstype(1:1) = 'F' - else - rhscrd = 0 - nrhs = 0 - end if - totcrd = ptrcrd + indcrd + valcrd + rhscrd - - nrhsix = nrhs*nrow - - if (present(g)) then - rhstype(2:2) = 'G' - end if - if (present(x)) then - rhstype(3:3) = 'X' - end if - type = 'RUA' - - write (iout,fmt=fmt10) mtitle_,key_,totcrd,ptrcrd,indcrd,valcrd,rhscrd,& - & type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt - if (rhscrd > 0) write (iout,fmt=fmt11) rhstype,nrhs,nrhsix - write (iout,fmt=ptrfmt) (acpnt%icp(i),i=1,ncol+1) - write (iout,fmt=indfmt) (acpnt%ia(i),i=1,nnzero) - if (valcrd > 0) write (iout,fmt=valfmt) (acpnt%val(i),i=1,nnzero) - if (rhscrd > 0) write (iout,fmt=rhsfmt) (rhs(i),i=1,nrow) - if (present(g).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (g(i),i=1,nrow) - if (present(x).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (x(i),i=1,nrow) - - - - - if (iout /= 6) close(iout) - - - return - -901 continue - iret=901 - write(psb_err_unit,*) 'Error while opening ',filename - return -end subroutine dhb_write - - - - -subroutine chb_read(a, iret, iunit, filename,b,g,x,mtitle) - use psb_base_mod - implicit none - type(psb_cspmat_type), intent(out) :: a - integer, intent(out) :: iret - integer, optional, intent(in) :: iunit - character(len=*), optional, intent(in) :: filename - complex(psb_spk_), optional, allocatable, intent(out) :: b(:,:), g(:,:), x(:,:) - character(len=72), optional, intent(out) :: mtitle - - character :: rhstype*3,type*3,key*8 - character(len=72) :: mtitle_ - character indfmt*16,ptrfmt*16,rhsfmt*20,valfmt*20 - integer :: indcrd, ptrcrd, totcrd,& - & valcrd, rhscrd, nrow, ncol, nnzero, neltvl, nrhs, nrhsix - type(psb_c_csc_sparse_mat) :: acsc - type(psb_c_coo_sparse_mat) :: acoo - integer :: ircode, i,nzr,infile, info - character(len=*), parameter :: fmt10='(a72,a8,/,5i14,/,a3,11x,4i14,/,2a16,2a20)' - character(len=*), parameter :: fmt11='(a3,11x,2i14)' - character(len=*), parameter :: fmt111='(1x,a8,1x,i8,1x,a10)' - - iret = 0 - - if (present(filename)) then - if (filename == '-') then - infile=5 - else - if (present(iunit)) then - infile=iunit - else - infile=99 - endif - open(infile,file=filename, status='OLD', err=901, action='READ') - endif - else - if (present(iunit)) then - infile=iunit - else - infile=5 - endif - endif - - read (infile,fmt=fmt10) mtitle_,key,totcrd,ptrcrd,indcrd,valcrd,rhscrd,& - & type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt - if (rhscrd > 0) read(infile,fmt=fmt11)rhstype,nrhs,nrhsix - - call acsc%allocate(nrow,ncol,nnzero) - if (ircode /= 0 ) then - write(psb_err_unit,*) 'Memory allocation failed' - goto 993 - end if - - if (present(mtitle)) mtitle=mtitle_ - - - if (psb_tolower(type(1:1)) == 'c') then - if (psb_tolower(type(2:2)) == 'u') then - - - read (infile,fmt=ptrfmt) (acsc%icp(i),i=1,ncol+1) - read (infile,fmt=indfmt) (acsc%ia(i),i=1,nnzero) - if (valcrd > 0) read (infile,fmt=valfmt) (acsc%val(i),i=1,nnzero) - - call a%mv_from(acsc) - - if (present(b)) then - if ((psb_toupper(rhstype(1:1)) == 'F').and.(rhscrd > 0)) then - call psb_realloc(nrow,1,b,info) - read (infile,fmt=rhsfmt) (b(i,1),i=1,nrow) - endif - endif - if (present(g)) then - if ((psb_toupper(rhstype(2:2)) == 'G').and.(rhscrd > 0)) then - call psb_realloc(nrow,1,g,info) - read (infile,fmt=rhsfmt) (g(i,1),i=1,nrow) - endif - endif - if (present(x)) then - if ((psb_toupper(rhstype(3:3)) == 'X').and.(rhscrd > 0)) then - call psb_realloc(nrow,1,x,info) - read (infile,fmt=rhsfmt) (x(i,1),i=1,nrow) - endif - endif - - else if (psb_tolower(type(2:2)) == 's') then - - ! we are generally working with non-symmetric matrices, so - ! we de-symmetrize what we are about to read - - read (infile,fmt=ptrfmt) (acsc%icp(i),i=1,ncol+1) - read (infile,fmt=indfmt) (acsc%ia(i),i=1,nnzero) - if (valcrd > 0) read (infile,fmt=valfmt) (acsc%val(i),i=1,nnzero) - - - if (present(b)) then - if ((psb_toupper(rhstype(1:1)) == 'F').and.(rhscrd > 0)) then - call psb_realloc(nrow,1,b,info) - read (infile,fmt=rhsfmt) (b(i,1),i=1,nrow) - endif - endif - if (present(g)) then - if ((psb_toupper(rhstype(2:2)) == 'G').and.(rhscrd > 0)) then - call psb_realloc(nrow,1,g,info) - read (infile,fmt=rhsfmt) (g(i,1),i=1,nrow) - endif - endif - if (present(x)) then - if ((psb_toupper(rhstype(3:3)) == 'X').and.(rhscrd > 0)) then - call psb_realloc(nrow,1,x,info) - read (infile,fmt=rhsfmt) (x(i,1),i=1,nrow) - endif - endif - - - call acoo%mv_from_fmt(acsc,info) - call acoo%reallocate(2*nnzero) - ! A is now in COO format - nzr = nnzero - do i=1,nnzero - if (acoo%ia(i) /= acoo%ja(i)) then - nzr = nzr + 1 - acoo%val(nzr) = acoo%val(i) - acoo%ia(nzr) = acoo%ja(i) - acoo%ja(nzr) = acoo%ia(i) - end if - end do - call acoo%set_nzeros(nzr) - call acoo%fix(ircode) - if (ircode == 0) call a%mv_from(acoo) - if (ircode /= 0) goto 993 - - else if (psb_tolower(type(2:2)) == 'h') then - - ! we are generally working with non-symmetric matrices, so - ! we de-symmetrize what we are about to read - - read (infile,fmt=ptrfmt) (acsc%icp(i),i=1,ncol+1) - read (infile,fmt=indfmt) (acsc%ia(i),i=1,nnzero) - if (valcrd > 0) read (infile,fmt=valfmt) (acsc%val(i),i=1,nnzero) - - - if (present(b)) then - if ((psb_toupper(rhstype(1:1)) == 'F').and.(rhscrd > 0)) then - call psb_realloc(nrow,1,b,info) - read (infile,fmt=rhsfmt) (b(i,1),i=1,nrow) - endif - endif - if (present(g)) then - if ((psb_toupper(rhstype(2:2)) == 'G').and.(rhscrd > 0)) then - call psb_realloc(nrow,1,g,info) - read (infile,fmt=rhsfmt) (g(i,1),i=1,nrow) - endif - endif - if (present(x)) then - if ((psb_toupper(rhstype(3:3)) == 'X').and.(rhscrd > 0)) then - call psb_realloc(nrow,1,x,info) - read (infile,fmt=rhsfmt) (x(i,1),i=1,nrow) - endif - endif - - - call acoo%mv_from_fmt(acsc,info) - call acoo%reallocate(2*nnzero) - ! A is now in COO format - nzr = nnzero - do i=1,nnzero - if (acoo%ia(i) /= acoo%ja(i)) then - nzr = nzr + 1 - acoo%val(nzr) = conjg(acoo%val(i)) - acoo%ia(nzr) = acoo%ja(i) - acoo%ja(nzr) = acoo%ia(i) - end if - end do - call acoo%set_nzeros(nzr) - call acoo%fix(ircode) - if (ircode == 0) call a%mv_from(acoo) - if (ircode /= 0) goto 993 - - else - write(psb_err_unit,*) 'read_matrix: matrix type not yet supported' - iret=904 - end if - else - write(psb_err_unit,*) 'read_matrix: matrix type not yet supported' - iret=904 - end if - - call a%cscnv(ircode,type='csr') - if (infile /= 5) close(infile) - - return - - ! open failed -901 iret=901 - write(psb_err_unit,*) 'read_matrix: could not open file ',filename,' for input' - return -902 iret=902 - write(psb_err_unit,*) 'HB_READ: Unexpected end of file ' - return -993 iret=993 - write(psb_err_unit,*) 'HB_READ: Memory allocation failure' - return -end subroutine chb_read - -subroutine chb_write(a,iret,iunit,filename,key,rhs,g,x,mtitle) - use psb_base_mod - implicit none - type(psb_cspmat_type), intent(in), target :: a - integer, intent(out) :: iret - character(len=*), optional, intent(in) :: mtitle - integer, optional, intent(in) :: iunit - character(len=*), optional, intent(in) :: filename - character(len=*), optional, intent(in) :: key - complex(psb_spk_), optional :: rhs(:), g(:), x(:) - integer :: iout - - character(len=*), parameter:: ptrfmt='(10I8)',indfmt='(10I8)' - integer, parameter :: jptr=10,jind=10 - character(len=*), parameter:: valfmt='(4E20.12)',rhsfmt='(4E20.12)' - integer, parameter :: jval=2,jrhs=2 - character(len=*), parameter :: fmt10='(a72,a8,/,5i14,/,a3,11x,4i14,/,2a16,2a20)' - character(len=*), parameter :: fmt11='(a3,11x,2i14)' - character(len=*), parameter :: fmt111='(1x,a8,1x,i8,1x,a10)' - - type(psb_c_csc_sparse_mat), target :: acsc - type(psb_c_csc_sparse_mat), pointer :: acpnt - character(len=72) :: mtitle_ - character(len=8) :: key_ - - character :: rhstype*3,type*3 - - integer :: i,indcrd,ptrcrd,rhscrd,totcrd,valcrd,& - & nrow,ncol,nnzero, neltvl, nrhs, nrhsix - - iret = 0 - - if (present(filename)) then - if (filename == '-') then - iout=6 - else - if (present(iunit)) then - iout = iunit - else - iout=99 - endif - open(iout,file=filename, err=901, action='WRITE') - endif - else - if (present(iunit)) then - iout = iunit - else - iout=6 - endif - endif - - if (present(mtitle)) then - mtitle_ = mtitle - else - mtitle_ = 'Temporary PSBLAS title ' - endif - if (present(key)) then - key_ = key - else - key_ = 'PSBMAT00' - endif - - - select type(aa=>a%a) - type is (psb_c_csc_sparse_mat) - - acpnt => aa - - class default - - call acsc%cp_from_fmt(aa, iret) - if (iret /= 0) return - acpnt => acsc - - end select - - - nrow = acpnt%get_nrows() - ncol = acpnt%get_ncols() - nnzero = acpnt%get_nzeros() - - neltvl = 0 - - ptrcrd = (ncol+1)/jptr - if (mod(ncol+1,jptr) > 0) ptrcrd = ptrcrd + 1 - indcrd = nnzero/jind - if (mod(nnzero,jind) > 0) indcrd = indcrd + 1 - valcrd = nnzero/jval - if (mod(nnzero,jval) > 0) valcrd = valcrd + 1 - rhstype = '' - if (present(rhs)) then - if (size(rhs) 0) rhscrd = rhscrd + 1 - endif - nrhs = 1 - rhstype(1:1) = 'F' - else - rhscrd = 0 - nrhs = 0 - end if - totcrd = ptrcrd + indcrd + valcrd + rhscrd - - nrhsix = nrhs*nrow - - if (present(g)) then - rhstype(2:2) = 'G' - end if - if (present(x)) then - rhstype(3:3) = 'X' - end if - type = 'CUA' - - write (iout,fmt=fmt10) mtitle_,key_,totcrd,ptrcrd,indcrd,valcrd,rhscrd,& - & type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt - if (rhscrd > 0) write (iout,fmt=fmt11) rhstype,nrhs,nrhsix - write (iout,fmt=ptrfmt) (acpnt%icp(i),i=1,ncol+1) - write (iout,fmt=indfmt) (acpnt%ia(i),i=1,nnzero) - if (valcrd > 0) write (iout,fmt=valfmt) (acpnt%val(i),i=1,nnzero) - if (rhscrd > 0) write (iout,fmt=rhsfmt) (rhs(i),i=1,nrow) - if (present(g).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (g(i),i=1,nrow) - if (present(x).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (x(i),i=1,nrow) - - - - - if (iout /= 6) close(iout) - - - return - -901 continue - iret=901 - write(psb_err_unit,*) 'Error while opening ',filename - return -end subroutine chb_write - - - -subroutine zhb_read(a, iret, iunit, filename,b,g,x,mtitle) - use psb_base_mod - implicit none - type(psb_zspmat_type), intent(out) :: a - integer, intent(out) :: iret - integer, optional, intent(in) :: iunit - character(len=*), optional, intent(in) :: filename - complex(psb_dpk_), optional, allocatable, intent(out) :: b(:,:), g(:,:), x(:,:) - character(len=72), optional, intent(out) :: mtitle - - character :: rhstype*3,type*3,key*8 - character(len=72) :: mtitle_ - character indfmt*16,ptrfmt*16,rhsfmt*20,valfmt*20 - integer :: indcrd, ptrcrd, totcrd,& - & valcrd, rhscrd, nrow, ncol, nnzero, neltvl, nrhs, nrhsix - type(psb_z_csc_sparse_mat) :: acsc - type(psb_z_coo_sparse_mat) :: acoo - integer :: ircode, i,nzr,infile, info - character(len=*), parameter :: fmt10='(a72,a8,/,5i14,/,a3,11x,4i14,/,2a16,2a20)' - character(len=*), parameter :: fmt11='(a3,11x,2i14)' - character(len=*), parameter :: fmt111='(1x,a8,1x,i8,1x,a10)' - - iret = 0 - - if (present(filename)) then - if (filename == '-') then - infile=5 - else - if (present(iunit)) then - infile=iunit - else - infile=99 - endif - open(infile,file=filename, status='OLD', err=901, action='READ') - endif - else - if (present(iunit)) then - infile=iunit - else - infile=5 - endif - endif - - read (infile,fmt=fmt10) mtitle_,key,totcrd,ptrcrd,indcrd,valcrd,rhscrd,& - & type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt - if (rhscrd > 0) read(infile,fmt=fmt11)rhstype,nrhs,nrhsix - - call acsc%allocate(nrow,ncol,nnzero) - if (ircode /= 0 ) then - write(psb_err_unit,*) 'Memory allocation failed' - goto 993 - end if - - if (present(mtitle)) mtitle=mtitle_ - - - if (psb_tolower(type(1:1)) == 'c') then - if (psb_tolower(type(2:2)) == 'u') then - - - read (infile,fmt=ptrfmt) (acsc%icp(i),i=1,ncol+1) - read (infile,fmt=indfmt) (acsc%ia(i),i=1,nnzero) - if (valcrd > 0) read (infile,fmt=valfmt) (acsc%val(i),i=1,nnzero) - - call a%mv_from(acsc) - - if (present(b)) then - if ((psb_toupper(rhstype(1:1)) == 'F').and.(rhscrd > 0)) then - call psb_realloc(nrow,1,b,info) - read (infile,fmt=rhsfmt) (b(i,1),i=1,nrow) - endif - endif - if (present(g)) then - if ((psb_toupper(rhstype(2:2)) == 'G').and.(rhscrd > 0)) then - call psb_realloc(nrow,1,g,info) - read (infile,fmt=rhsfmt) (g(i,1),i=1,nrow) - endif - endif - if (present(x)) then - if ((psb_toupper(rhstype(3:3)) == 'X').and.(rhscrd > 0)) then - call psb_realloc(nrow,1,x,info) - read (infile,fmt=rhsfmt) (x(i,1),i=1,nrow) - endif - endif - - else if (psb_tolower(type(2:2)) == 's') then - - ! we are generally working with non-symmetric matrices, so - ! we de-symmetrize what we are about to read - - read (infile,fmt=ptrfmt) (acsc%icp(i),i=1,ncol+1) - read (infile,fmt=indfmt) (acsc%ia(i),i=1,nnzero) - if (valcrd > 0) read (infile,fmt=valfmt) (acsc%val(i),i=1,nnzero) - - - if (present(b)) then - if ((psb_toupper(rhstype(1:1)) == 'F').and.(rhscrd > 0)) then - call psb_realloc(nrow,1,b,info) - read (infile,fmt=rhsfmt) (b(i,1),i=1,nrow) - endif - endif - if (present(g)) then - if ((psb_toupper(rhstype(2:2)) == 'G').and.(rhscrd > 0)) then - call psb_realloc(nrow,1,g,info) - read (infile,fmt=rhsfmt) (g(i,1),i=1,nrow) - endif - endif - if (present(x)) then - if ((psb_toupper(rhstype(3:3)) == 'X').and.(rhscrd > 0)) then - call psb_realloc(nrow,1,x,info) - read (infile,fmt=rhsfmt) (x(i,1),i=1,nrow) - endif - endif - - - call acoo%mv_from_fmt(acsc,info) - call acoo%reallocate(2*nnzero) - ! A is now in COO format - nzr = nnzero - do i=1,nnzero - if (acoo%ia(i) /= acoo%ja(i)) then - nzr = nzr + 1 - acoo%val(nzr) = acoo%val(i) - acoo%ia(nzr) = acoo%ja(i) - acoo%ja(nzr) = acoo%ia(i) - end if - end do - call acoo%set_nzeros(nzr) - call acoo%fix(ircode) - if (ircode == 0) call a%mv_from(acoo) - if (ircode /= 0) goto 993 - - else if (psb_tolower(type(2:2)) == 'h') then - - ! we are generally working with non-symmetric matrices, so - ! we de-symmetrize what we are about to read - - read (infile,fmt=ptrfmt) (acsc%icp(i),i=1,ncol+1) - read (infile,fmt=indfmt) (acsc%ia(i),i=1,nnzero) - if (valcrd > 0) read (infile,fmt=valfmt) (acsc%val(i),i=1,nnzero) - - - if (present(b)) then - if ((psb_toupper(rhstype(1:1)) == 'F').and.(rhscrd > 0)) then - call psb_realloc(nrow,1,b,info) - read (infile,fmt=rhsfmt) (b(i,1),i=1,nrow) - endif - endif - if (present(g)) then - if ((psb_toupper(rhstype(2:2)) == 'G').and.(rhscrd > 0)) then - call psb_realloc(nrow,1,g,info) - read (infile,fmt=rhsfmt) (g(i,1),i=1,nrow) - endif - endif - if (present(x)) then - if ((psb_toupper(rhstype(3:3)) == 'X').and.(rhscrd > 0)) then - call psb_realloc(nrow,1,x,info) - read (infile,fmt=rhsfmt) (x(i,1),i=1,nrow) - endif - endif - - - call acoo%mv_from_fmt(acsc,info) - call acoo%reallocate(2*nnzero) - ! A is now in COO format - nzr = nnzero - do i=1,nnzero - if (acoo%ia(i) /= acoo%ja(i)) then - nzr = nzr + 1 - acoo%val(nzr) = conjg(acoo%val(i)) - acoo%ia(nzr) = acoo%ja(i) - acoo%ja(nzr) = acoo%ia(i) - end if - end do - call acoo%set_nzeros(nzr) - call acoo%fix(ircode) - if (ircode == 0) call a%mv_from(acoo) - if (ircode /= 0) goto 993 - - else - write(psb_err_unit,*) 'read_matrix: matrix type not yet supported' - iret=904 - end if - else - write(psb_err_unit,*) 'read_matrix: matrix type not yet supported' - iret=904 - end if - - call a%cscnv(ircode,type='csr') - if (infile /= 5) close(infile) - - return - - ! open failed -901 iret=901 - write(psb_err_unit,*) 'read_matrix: could not open file ',filename,' for input' - return -902 iret=902 - write(psb_err_unit,*) 'HB_READ: Unexpected end of file ' - return -993 iret=993 - write(psb_err_unit,*) 'HB_READ: Memory allocation failure' - return -end subroutine zhb_read - -subroutine zhb_write(a,iret,iunit,filename,key,rhs,g,x,mtitle) - use psb_base_mod - implicit none - type(psb_zspmat_type), intent(in), target :: a - integer, intent(out) :: iret - character(len=*), optional, intent(in) :: mtitle - integer, optional, intent(in) :: iunit - character(len=*), optional, intent(in) :: filename - character(len=*), optional, intent(in) :: key - complex(psb_dpk_), optional :: rhs(:), g(:), x(:) - integer :: iout - - character(len=*), parameter:: ptrfmt='(10I8)',indfmt='(10I8)' - integer, parameter :: jptr=10,jind=10 - character(len=*), parameter:: valfmt='(4E20.12)',rhsfmt='(4E20.12)' - integer, parameter :: jval=2,jrhs=2 - character(len=*), parameter :: fmt10='(a72,a8,/,5i14,/,a3,11x,4i14,/,2a16,2a20)' - character(len=*), parameter :: fmt11='(a3,11x,2i14)' - character(len=*), parameter :: fmt111='(1x,a8,1x,i8,1x,a10)' - - type(psb_z_csc_sparse_mat), target :: acsc - type(psb_z_csc_sparse_mat), pointer :: acpnt - character(len=72) :: mtitle_ - character(len=8) :: key_ - - character :: rhstype*3,type*3 - - integer :: i,indcrd,ptrcrd,rhscrd,totcrd,valcrd,& - & nrow,ncol,nnzero, neltvl, nrhs, nrhsix - - iret = 0 - - if (present(filename)) then - if (filename == '-') then - iout=6 - else - if (present(iunit)) then - iout = iunit - else - iout=99 - endif - open(iout,file=filename, err=901, action='WRITE') - endif - else - if (present(iunit)) then - iout = iunit - else - iout=6 - endif - endif - - if (present(mtitle)) then - mtitle_ = mtitle - else - mtitle_ = 'Temporary PSBLAS title ' - endif - if (present(key)) then - key_ = key - else - key_ = 'PSBMAT00' - endif - - - select type(aa=>a%a) - type is (psb_z_csc_sparse_mat) - - acpnt => aa - - class default - - call acsc%cp_from_fmt(aa, iret) - if (iret /= 0) return - acpnt => acsc - - end select - - - nrow = acpnt%get_nrows() - ncol = acpnt%get_ncols() - nnzero = acpnt%get_nzeros() - - neltvl = 0 - - ptrcrd = (ncol+1)/jptr - if (mod(ncol+1,jptr) > 0) ptrcrd = ptrcrd + 1 - indcrd = nnzero/jind - if (mod(nnzero,jind) > 0) indcrd = indcrd + 1 - valcrd = nnzero/jval - if (mod(nnzero,jval) > 0) valcrd = valcrd + 1 - rhstype = '' - if (present(rhs)) then - if (size(rhs) 0) rhscrd = rhscrd + 1 - endif - nrhs = 1 - rhstype(1:1) = 'F' - else - rhscrd = 0 - nrhs = 0 - end if - totcrd = ptrcrd + indcrd + valcrd + rhscrd - - nrhsix = nrhs*nrow - - if (present(g)) then - rhstype(2:2) = 'G' - end if - if (present(x)) then - rhstype(3:3) = 'X' - end if - type = 'CUA' - - write (iout,fmt=fmt10) mtitle_,key_,totcrd,ptrcrd,indcrd,valcrd,rhscrd,& - & type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt - if (rhscrd > 0) write (iout,fmt=fmt11) rhstype,nrhs,nrhsix - write (iout,fmt=ptrfmt) (acpnt%icp(i),i=1,ncol+1) - write (iout,fmt=indfmt) (acpnt%ia(i),i=1,nnzero) - if (valcrd > 0) write (iout,fmt=valfmt) (acpnt%val(i),i=1,nnzero) - if (rhscrd > 0) write (iout,fmt=rhsfmt) (rhs(i),i=1,nrow) - if (present(g).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (g(i),i=1,nrow) - if (present(x).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (x(i),i=1,nrow) - - - - - if (iout /= 6) close(iout) - - - return - -901 continue - iret=901 - write(psb_err_unit,*) 'Error while opening ',filename - return -end subroutine zhb_write - diff --git a/util/psb_mat_dist_mod.f90 b/util/psb_mat_dist_mod.f90 index efff3e38b..cd6be7341 100644 --- a/util/psb_mat_dist_mod.f90 +++ b/util/psb_mat_dist_mod.f90 @@ -91,7 +91,7 @@ module psb_mat_dist_mod ! on exit : unchanged. ! use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_,& - & psb_s_base_sparse_mat + & psb_s_base_sparse_mat, psb_s_vect_type implicit none ! parameters @@ -99,7 +99,7 @@ module psb_mat_dist_mod real(psb_spk_) :: b_glob(:) integer :: ictxt type(psb_sspmat_type) :: a - real(psb_spk_), allocatable :: b(:) + type(psb_s_vect_type) :: b type(psb_desc_type) :: desc_a integer, intent(out) :: info integer, optional :: inroot @@ -177,7 +177,7 @@ module psb_mat_dist_mod ! on exit : unchanged. ! use psb_base_mod, only : psb_dspmat_type, psb_dpk_, psb_desc_type,& - & psb_d_base_sparse_mat + & psb_d_base_sparse_mat, psb_d_vect_type implicit none ! parameters @@ -185,7 +185,7 @@ module psb_mat_dist_mod real(psb_dpk_) :: b_glob(:) integer :: ictxt type(psb_dspmat_type) :: a - real(psb_dpk_), allocatable :: b(:) + type(psb_d_vect_type) :: b type(psb_desc_type) :: desc_a integer, intent(out) :: info integer, optional :: inroot @@ -264,7 +264,7 @@ module psb_mat_dist_mod ! on exit : unchanged. ! use psb_base_mod, only : psb_cspmat_type, psb_spk_, psb_desc_type,& - & psb_c_base_sparse_mat + & psb_c_base_sparse_mat, psb_c_vect_type implicit none ! parameters @@ -272,7 +272,7 @@ module psb_mat_dist_mod complex(psb_spk_) :: b_glob(:) integer :: ictxt type(psb_cspmat_type) :: a - complex(psb_spk_), allocatable :: b(:) + type(psb_c_vect_type) :: b type(psb_desc_type) :: desc_a integer, intent(out) :: info integer, optional :: inroot @@ -351,7 +351,7 @@ module psb_mat_dist_mod ! on exit : unchanged. ! use psb_base_mod, only : psb_zspmat_type, psb_dpk_, psb_desc_type,& - & psb_z_base_sparse_mat + & psb_z_base_sparse_mat, psb_z_vect_type implicit none ! parameters @@ -359,7 +359,7 @@ module psb_mat_dist_mod complex(psb_dpk_) :: b_glob(:) integer :: ictxt type(psb_zspmat_type) :: a - complex(psb_dpk_), allocatable :: b(:) + type(psb_z_vect_type) :: b type(psb_desc_type) :: desc_a integer, intent(out) :: info integer, optional :: inroot diff --git a/util/psb_mmio_impl.f90 b/util/psb_mmio_impl.f90 deleted file mode 100644 index 32f1ad9d6..000000000 --- a/util/psb_mmio_impl.f90 +++ /dev/null @@ -1,1423 +0,0 @@ -!!$ -!!$ Parallel Sparse BLAS version 3.0 -!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 -!!$ Salvatore Filippone University of Rome Tor Vergata -!!$ Alfredo Buttari CNRS-IRIT, Toulouse -!!$ -!!$ Redistribution and use in source and binary forms, with or without -!!$ modification, are permitted provided that the following conditions -!!$ are met: -!!$ 1. Redistributions of source code must retain the above copyright -!!$ notice, this list of conditions and the following disclaimer. -!!$ 2. Redistributions in binary form must reproduce the above copyright -!!$ notice, this list of conditions, and the following disclaimer in the -!!$ documentation and/or other materials provided with the distribution. -!!$ 3. The name of the PSBLAS group or the names of its contributors may -!!$ not be used to endorse or promote products derived from this -!!$ software without specific written permission. -!!$ -!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS -!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -!!$ POSSIBILITY OF SUCH DAMAGE. -!!$ -!!$ -subroutine mm_svet_read(b, info, iunit, filename) - use psb_base_mod - implicit none - real(psb_spk_), allocatable, intent(out) :: b(:,:) - integer, intent(out) :: info - integer, optional, intent(in) :: iunit - character(len=*), optional, intent(in) :: filename - integer :: nrow, ncol, i,root, np, me, ircode, j,infile - character :: mmheader*15, fmt*15, object*10, type*10, sym*15,& - & line*1024 - - info = psb_success_ - if (present(filename)) then - if (filename == '-') then - infile=5 - else - if (present(iunit)) then - infile=iunit - else - infile=99 - endif - open(infile,file=filename, status='OLD', err=901, action='READ') - endif - else - if (present(iunit)) then - infile=iunit - else - infile=5 - endif - endif - - read(infile,fmt=*, end=902) mmheader, object, fmt, type, sym - - if ( (object /= 'matrix').or.(fmt /= 'array')) then - write(psb_err_unit,*) 'read_rhs: input file type not yet supported' - info = -3 - return - end if - - do - read(infile,fmt='(a)') line - if (line(1:1) /= '%') exit - end do - - read(line,fmt=*)nrow,ncol - - if ((psb_tolower(type) == 'real').and.(psb_tolower(sym) == 'general')) then - allocate(b(nrow,ncol),stat = ircode) - if (ircode /= 0) goto 993 - read(infile,fmt=*,end=902) ((b(i,j), i=1,nrow),j=1,ncol) - - end if ! read right hand sides - - if (infile /= 5) close(infile) - - return - ! open failed -901 write(psb_err_unit,*) 'mm_vet_read: could not open file ',& - & infile,' for input' - info = -1 - return - -902 write(psb_err_unit,*) 'mmv_vet_read: unexpected end of file ',infile,& - & ' during input' - info = -2 - return -993 write(psb_err_unit,*) 'mm_vet_read: memory allocation failure' - info = -3 - return -end subroutine mm_svet_read - - -subroutine mm_dvet_read(b, info, iunit, filename) - use psb_base_mod - implicit none - real(psb_dpk_), allocatable, intent(out) :: b(:,:) - integer, intent(out) :: info - integer, optional, intent(in) :: iunit - character(len=*), optional, intent(in) :: filename - integer :: nrow, ncol, i,root, np, me, ircode, j, infile - character :: mmheader*15, fmt*15, object*10, type*10, sym*15,& - & line*1024 - - info = psb_success_ - if (present(filename)) then - if (filename == '-') then - infile=5 - else - if (present(iunit)) then - infile=iunit - else - infile=99 - endif - open(infile,file=filename, status='OLD', err=901, action='READ') - endif - else - if (present(iunit)) then - infile=iunit - else - infile=5 - endif - endif - - read(infile,fmt=*, end=902) mmheader, object, fmt, type, sym - - if ( (object /= 'matrix').or.(fmt /= 'array')) then - write(psb_err_unit,*) 'read_rhs: input file type not yet supported' - info = -3 - return - end if - - do - read(infile,fmt='(a)') line - if (line(1:1) /= '%') exit - end do - - read(line,fmt=*)nrow,ncol - - if ((psb_tolower(type) == 'real').and.(psb_tolower(sym) == 'general')) then - allocate(b(nrow,ncol),stat = ircode) - if (ircode /= 0) goto 993 - read(infile,fmt=*,end=902) ((b(i,j), i=1,nrow),j=1,ncol) - - end if ! read right hand sides - if (infile /= 5) close(infile) - - return - ! open failed -901 write(psb_err_unit,*) 'mm_vet_read: could not open file ',& - & infile,' for input' - info = -1 - return - -902 write(psb_err_unit,*) 'mmv_vet_read: unexpected end of file ',infile,& - & ' during input' - info = -2 - return -993 write(psb_err_unit,*) 'mm_vet_read: memory allocation failure' - info = -3 - return -end subroutine mm_dvet_read - - -subroutine mm_cvet_read(b, info, iunit, filename) - use psb_base_mod - implicit none - complex(psb_spk_), allocatable, intent(out) :: b(:,:) - integer, intent(out) :: info - integer, optional, intent(in) :: iunit - character(len=*), optional, intent(in) :: filename - integer :: nrow, ncol, i,root, np, me, ircode, j,infile - real(psb_spk_) :: bre, bim - character :: mmheader*15, fmt*15, object*10, type*10, sym*15,& - & line*1024 - - info = psb_success_ - if (present(filename)) then - if (filename == '-') then - infile=5 - else - if (present(iunit)) then - infile=iunit - else - infile=99 - endif - open(infile,file=filename, status='OLD', err=901, action='READ') - endif - else - if (present(iunit)) then - infile=iunit - else - infile=5 - endif - endif - - read(infile,fmt=*, end=902) mmheader, object, fmt, type, sym - - if ( (object /= 'matrix').or.(fmt /= 'array')) then - write(psb_err_unit,*) 'read_rhs: input file type not yet supported' - info = -3 - return - end if - - do - read(infile,fmt='(a)') line - if (line(1:1) /= '%') exit - end do - - read(line,fmt=*)nrow,ncol - - if ((psb_tolower(type) == 'real').and.(psb_tolower(sym) == 'general')) then - allocate(b(nrow,ncol),stat = ircode) - if (ircode /= 0) goto 993 - do j=1, ncol - do i=1, nrow - read(infile,fmt=*,end=902) bre,bim - b(i,j) = cmplx(bre,bim,kind=psb_spk_) - end do - end do - - end if ! read right hand sides - if (infile /= 5) close(infile) - - return - ! open failed -901 write(psb_err_unit,*) 'mm_vet_read: could not open file ',& - & infile,' for input' - info = -1 - return - -902 write(psb_err_unit,*) 'mmv_vet_read: unexpected end of file ',infile,& - & ' during input' - info = -2 - return -993 write(psb_err_unit,*) 'mm_vet_read: memory allocation failure' - info = -3 - return -end subroutine mm_cvet_read - - -subroutine mm_zvet_read(b, info, iunit, filename) - use psb_base_mod - implicit none - complex(psb_dpk_), allocatable, intent(out) :: b(:,:) - integer, intent(out) :: info - integer, optional, intent(in) :: iunit - character(len=*), optional, intent(in) :: filename - integer :: nrow, ncol, i,root, np, me, ircode, j,infile - real(psb_dpk_) :: bre, bim - character :: mmheader*15, fmt*15, object*10, type*10, sym*15,& - & line*1024 - - info = psb_success_ - if (present(filename)) then - if (filename == '-') then - infile=5 - else - if (present(iunit)) then - infile=iunit - else - infile=99 - endif - open(infile,file=filename, status='OLD', err=901, action='READ') - endif - else - if (present(iunit)) then - infile=iunit - else - infile=5 - endif - endif - - read(infile,fmt=*, end=902) mmheader, object, fmt, type, sym - - if ( (object /= 'matrix').or.(fmt /= 'array')) then - write(psb_err_unit,*) 'read_rhs: input file type not yet supported' - info = -3 - return - end if - - do - read(infile,fmt='(a)') line - if (line(1:1) /= '%') exit - end do - - read(line,fmt=*)nrow,ncol - - if ((psb_tolower(type) == 'real').and.(psb_tolower(sym) == 'general')) then - allocate(b(nrow,ncol),stat = ircode) - if (ircode /= 0) goto 993 - do j=1, ncol - do i=1, nrow - read(infile,fmt=*,end=902) bre,bim - b(i,j) = cmplx(bre,bim,kind=psb_dpk_) - end do - end do - - end if ! read right hand sides - if (infile /= 5) close(infile) - - return - ! open failed -901 write(psb_err_unit,*) 'mm_vet_read: could not open file ',& - & infile,' for input' - info = -1 - return - -902 write(psb_err_unit,*) 'mmv_vet_read: unexpected end of file ',infile,& - & ' during input' - info = -2 - return -993 write(psb_err_unit,*) 'mm_vet_read: memory allocation failure' - info = -3 - return -end subroutine mm_zvet_read - -subroutine mm_svet2_write(b, header, info, iunit, filename) - use psb_base_mod - implicit none - real(psb_spk_), intent(in) :: b(:,:) - character(len=*), intent(in) :: header - integer, intent(out) :: info - integer, optional, intent(in) :: iunit - character(len=*), optional, intent(in) :: filename - integer :: nrow, ncol, i,root, np, me, ircode, j, outfile - - character(len=80) :: frmtv - - info = psb_success_ - if (present(filename)) then - if (filename == '-') then - outfile=6 - else - if (present(iunit)) then - outfile=iunit - else - outfile=99 - endif - open(outfile,file=filename, err=901, action='WRITE') - endif - else - if (present(iunit)) then - outfile=iunit - else - outfile=6 - endif - endif - - write(outfile,'(a)') '%%MatrixMarket matrix array real general' - write(outfile,'(a)') '% '//trim(header) - write(outfile,'(a)') '% ' - nrow = size(b,1) - ncol = size(b,2) - write(outfile,*) nrow,ncol - - write(frmtv,'(a,i3.3,a)') '(',ncol,'(es26.18,1x))' - - do i=1,size(b,1) - write(outfile,frmtv) b(i,1:ncol) - end do - - if (outfile /= 6) close(outfile) - - return - ! open failed -901 write(psb_err_unit,*) 'mm_vet_write: could not open file ',& - & outfile,' for output' - info = -1 - return - -end subroutine mm_svet2_write - -subroutine mm_svet1_write(b, header, info, iunit, filename) - use psb_base_mod - implicit none - real(psb_spk_), intent(in) :: b(:) - character(len=*), intent(in) :: header - integer, intent(out) :: info - integer, optional, intent(in) :: iunit - character(len=*), optional, intent(in) :: filename - integer :: nrow, ncol, i,root, np, me, ircode, j, outfile - - character(len=80) :: frmtv - - info = psb_success_ - if (present(filename)) then - if (filename == '-') then - outfile=6 - else - if (present(iunit)) then - outfile=iunit - else - outfile=99 - endif - open(outfile,file=filename, err=901, action='WRITE') - endif - else - if (present(iunit)) then - outfile=iunit - else - outfile=6 - endif - endif - - write(outfile,'(a)') '%%MatrixMarket matrix array real general' - write(outfile,'(a)') '% '//trim(header) - write(outfile,'(a)') '% ' - nrow = size(b,1) - ncol = 1 - write(outfile,*) nrow,ncol - - write(frmtv,'(a,i3.3,a)') '(',ncol,'(es26.18,1x))' - - do i=1,size(b,1) - write(outfile,frmtv) b(i) - end do - - if (outfile /= 6) close(outfile) - - return - ! open failed -901 write(psb_err_unit,*) 'mm_vet_write: could not open file ',& - & outfile,' for output' - info = -1 - return - -end subroutine mm_svet1_write - - -subroutine mm_dvet2_write(b, header, info, iunit, filename) - use psb_base_mod - implicit none - real(psb_dpk_), intent(in) :: b(:,:) - character(len=*), intent(in) :: header - integer, intent(out) :: info - integer, optional, intent(in) :: iunit - character(len=*), optional, intent(in) :: filename - integer :: nrow, ncol, i,root, np, me, ircode, j, outfile - - character(len=80) :: frmtv - - info = psb_success_ - if (present(filename)) then - if (filename == '-') then - outfile=6 - else - if (present(iunit)) then - outfile=iunit - else - outfile=99 - endif - open(outfile,file=filename, err=901, action='WRITE') - endif - else - if (present(iunit)) then - outfile=iunit - else - outfile=6 - endif - endif - - write(outfile,'(a)') '%%MatrixMarket matrix array real general' - write(outfile,'(a)') '% '//trim(header) - write(outfile,'(a)') '% ' - nrow = size(b,1) - ncol = size(b,2) - write(outfile,*) nrow,ncol - - write(frmtv,'(a,i3.3,a)') '(',ncol,'(es26.18,1x))' - - do i=1,size(b,1) - write(outfile,frmtv) b(i,1:ncol) - end do - - if (outfile /= 6) close(outfile) - - return - ! open failed -901 write(psb_err_unit,*) 'mm_vet_write: could not open file ',& - & outfile,' for output' - info = -1 - return - -end subroutine mm_dvet2_write - -subroutine mm_dvet1_write(b, header, info, iunit, filename) - use psb_base_mod - implicit none - real(psb_dpk_), intent(in) :: b(:) - character(len=*), intent(in) :: header - integer, intent(out) :: info - integer, optional, intent(in) :: iunit - character(len=*), optional, intent(in) :: filename - integer :: nrow, ncol, i,root, np, me, ircode, j, outfile - - character(len=80) :: frmtv - - info = psb_success_ - if (present(filename)) then - if (filename == '-') then - outfile=6 - else - if (present(iunit)) then - outfile=iunit - else - outfile=99 - endif - open(outfile,file=filename, err=901, action='WRITE') - endif - else - if (present(iunit)) then - outfile=iunit - else - outfile=6 - endif - endif - - write(outfile,'(a)') '%%MatrixMarket matrix array real general' - write(outfile,'(a)') '% '//trim(header) - write(outfile,'(a)') '% ' - nrow = size(b,1) - ncol = 1 - write(outfile,*) nrow,ncol - - write(frmtv,'(a,i3.3,a)') '(',ncol,'(es26.18,1x))' - - do i=1,size(b,1) - write(outfile,frmtv) b(i) - end do - - if (outfile /= 6) close(outfile) - - return - ! open failed -901 write(psb_err_unit,*) 'mm_vet_write: could not open file ',& - & outfile,' for output' - info = -1 - return - -end subroutine mm_dvet1_write - - -subroutine mm_cvet2_write(b, header, info, iunit, filename) - use psb_base_mod - implicit none - complex(psb_spk_), intent(in) :: b(:,:) - character(len=*), intent(in) :: header - integer, intent(out) :: info - integer, optional, intent(in) :: iunit - character(len=*), optional, intent(in) :: filename - integer :: nrow, ncol, i,root, np, me, ircode, j, outfile - - character(len=80) :: frmtv - - info = psb_success_ - if (present(filename)) then - if (filename == '-') then - outfile=6 - else - if (present(iunit)) then - outfile=iunit - else - outfile=99 - endif - open(outfile,file=filename, err=901, action='WRITE') - endif - else - if (present(iunit)) then - outfile=iunit - else - outfile=6 - endif - endif - - write(outfile,'(a)') '%%MatrixMarket matrix array real general' - write(outfile,'(a)') '% '//trim(header) - write(outfile,'(a)') '% ' - nrow = size(b,1) - ncol = size(b,2) - write(outfile,*) nrow,ncol - - write(frmtv,'(a,i5.5,a)') '(',2*ncol,'(es26.18,1x))' - - do i=1,size(b,1) - write(outfile,frmtv) b(i,1:ncol) - end do - - if (outfile /= 6) close(outfile) - - return - ! open failed -901 write(psb_err_unit,*) 'mm_vet_write: could not open file ',& - & outfile,' for output' - info = -1 - return - -end subroutine mm_cvet2_write - -subroutine mm_cvet1_write(b, header, info, iunit, filename) - use psb_base_mod - implicit none - complex(psb_spk_), intent(in) :: b(:) - character(len=*), intent(in) :: header - integer, intent(out) :: info - integer, optional, intent(in) :: iunit - character(len=*), optional, intent(in) :: filename - integer :: nrow, ncol, i,root, np, me, ircode, j, outfile - - character(len=80) :: frmtv - - info = psb_success_ - if (present(filename)) then - if (filename == '-') then - outfile=6 - else - if (present(iunit)) then - outfile=iunit - else - outfile=99 - endif - open(outfile,file=filename, err=901, action='WRITE') - endif - else - if (present(iunit)) then - outfile=iunit - else - outfile=6 - endif - endif - - write(outfile,'(a)') '%%MatrixMarket matrix array real general' - write(outfile,'(a)') '% '//trim(header) - write(outfile,'(a)') '% ' - nrow = size(b,1) - ncol = 1 - write(outfile,*) nrow,ncol - - write(frmtv,'(a,i5.5,a)') '(',2*ncol,'(es26.18,1x))' - - do i=1,size(b,1) - write(outfile,frmtv) b(i) - end do - - if (outfile /= 6) close(outfile) - - return - ! open failed -901 write(psb_err_unit,*) 'mm_vet_write: could not open file ',& - & outfile,' for output' - info = -1 - return - -end subroutine mm_cvet1_write - -subroutine mm_zvet2_write(b, header, info, iunit, filename) - use psb_base_mod - implicit none - complex(psb_dpk_), intent(in) :: b(:,:) - character(len=*), intent(in) :: header - integer, intent(out) :: info - integer, optional, intent(in) :: iunit - character(len=*), optional, intent(in) :: filename - integer :: nrow, ncol, i,root, np, me, ircode, j, outfile - - character(len=80) :: frmtv - - info = psb_success_ - if (present(filename)) then - if (filename == '-') then - outfile=6 - else - if (present(iunit)) then - outfile=iunit - else - outfile=99 - endif - open(outfile,file=filename, err=901, action='WRITE') - endif - else - if (present(iunit)) then - outfile=iunit - else - outfile=6 - endif - endif - - write(outfile,'(a)') '%%MatrixMarket matrix array real general' - write(outfile,'(a)') '% '//trim(header) - write(outfile,'(a)') '% ' - nrow = size(b,1) - ncol = size(b,2) - write(outfile,*) nrow,ncol - - write(frmtv,'(a,i5.5,a)') '(',2*ncol,'(es26.18,1x))' - - do i=1,size(b,1) - write(outfile,frmtv) b(i,1:ncol) - end do - - if (outfile /= 6) close(outfile) - - return - ! open failed -901 write(psb_err_unit,*) 'mm_vet_write: could not open file ',& - & outfile,' for output' - info = -1 - return - -end subroutine mm_zvet2_write - -subroutine mm_zvet1_write(b, header, info, iunit, filename) - use psb_base_mod - implicit none - complex(psb_dpk_), intent(in) :: b(:) - character(len=*), intent(in) :: header - integer, intent(out) :: info - integer, optional, intent(in) :: iunit - character(len=*), optional, intent(in) :: filename - integer :: nrow, ncol, i,root, np, me, ircode, j, outfile - - character(len=80) :: frmtv - - info = psb_success_ - if (present(filename)) then - if (filename == '-') then - outfile=6 - else - if (present(iunit)) then - outfile=iunit - else - outfile=99 - endif - open(outfile,file=filename, err=901, action='WRITE') - endif - else - if (present(iunit)) then - outfile=iunit - else - outfile=6 - endif - endif - - write(outfile,'(a)') '%%MatrixMarket matrix array real general' - write(outfile,'(a)') '% '//trim(header) - write(outfile,'(a)') '% ' - nrow = size(b,1) - ncol = 1 - write(outfile,*) nrow,ncol - - write(frmtv,'(a,i5.5,a)') '(',2*ncol,'(es26.18,1x))' - - do i=1,size(b,1) - write(outfile,frmtv) b(i) - end do - - if (outfile /= 6) close(outfile) - - return - ! open failed -901 write(psb_err_unit,*) 'mm_vet_write: could not open file ',& - & outfile,' for output' - info = -1 - return - -end subroutine mm_zvet1_write - - -subroutine smm_mat_read(a, info, iunit, filename) - use psb_base_mod - implicit none - type(psb_sspmat_type), intent(out) :: a - integer, intent(out) :: info - integer, optional, intent(in) :: iunit - character(len=*), optional, intent(in) :: filename - character :: mmheader*15, fmt*15, object*10, type*10, sym*15 - character(1024) :: line - integer :: nrow, ncol, nnzero - integer :: ircode, i,nzr,infile - type(psb_s_coo_sparse_mat), allocatable :: acoo - - info = psb_success_ - - if (present(filename)) then - if (filename == '-') then - infile=5 - else - if (present(iunit)) then - infile=iunit - else - infile=99 - endif - open(infile,file=filename, status='OLD', err=901, action='READ') - endif - else - if (present(iunit)) then - infile=iunit - else - infile=5 - endif - endif - - read(infile,fmt=*,end=902) mmheader, object, fmt, type, sym - - if ( (psb_tolower(object) /= 'matrix').or.(psb_tolower(fmt) /= 'coordinate')) then - write(psb_err_unit,*) 'READ_MATRIX: input file type not yet supported' - info=909 - return - end if - - do - read(infile,fmt='(a)') line - if (line(1:1) /= '%') exit - end do - read(line,fmt=*) nrow,ncol,nnzero - - allocate(acoo, stat=ircode) - if (ircode /= 0) goto 993 - if ((psb_tolower(type) == 'real').and.(psb_tolower(sym) == 'general')) then - call acoo%allocate(nrow,ncol,nnzero) - do i=1,nnzero - read(infile,fmt=*,end=902) acoo%ia(i),acoo%ja(i),acoo%val(i) - end do - call acoo%set_nzeros(nnzero) - call acoo%fix(info) - - call a%mv_from(acoo) - call a%cscnv(ircode,type='csr') - - else if ((psb_tolower(type) == 'real').and.(psb_tolower(sym) == 'symmetric')) then - ! we are generally working with non-symmetric matrices, so - ! we de-symmetrize what we are about to read - call acoo%allocate(nrow,ncol,2*nnzero) - do i=1,nnzero - read(infile,fmt=*,end=902) acoo%ia(i),acoo%ja(i),acoo%val(i) - end do - nzr = nnzero - do i=1,nnzero - if (acoo%ia(i) /= acoo%ja(i)) then - nzr = nzr + 1 - acoo%val(nzr) = acoo%val(i) - acoo%ia(nzr) = acoo%ja(i) - acoo%ja(nzr) = acoo%ia(i) - end if - end do - call acoo%set_nzeros(nzr) - call acoo%fix(info) - - call a%mv_from(acoo) - call a%cscnv(ircode,type='csr') - - else - write(psb_err_unit,*) 'read_matrix: matrix type not yet supported' - info=904 - end if - - - if (infile /= 5) close(infile) - return - - ! open failed -901 info=901 - write(psb_err_unit,*) 'read_matrix: could not open file ',filename,' for input' - return -902 info=902 - write(psb_err_unit,*) 'READ_MATRIX: Unexpected end of file ' - return -993 info=993 - write(psb_err_unit,*) 'READ_MATRIX: Memory allocation failure' - return -end subroutine smm_mat_read - - -subroutine smm_mat_write(a,mtitle,info,iunit,filename) - use psb_base_mod - implicit none - type(psb_sspmat_type), intent(in) :: a - integer, intent(out) :: info - character(len=*), intent(in) :: mtitle - integer, optional, intent(in) :: iunit - character(len=*), optional, intent(in) :: filename - integer :: iout - - - info = psb_success_ - - if (present(filename)) then - if (filename == '-') then - iout=6 - else - if (present(iunit)) then - iout = iunit - else - iout=99 - endif - open(iout,file=filename, err=901, action='WRITE') - endif - else - if (present(iunit)) then - iout = iunit - else - iout=6 - endif - endif - - call a%print(iout,head=mtitle) - - if (iout /= 6) close(iout) - - - return - -901 continue - info=901 - write(psb_err_unit,*) 'Error while opening ',filename - return -end subroutine smm_mat_write - -subroutine dmm_mat_read(a, info, iunit, filename) - use psb_base_mod - implicit none - type(psb_dspmat_type), intent(out) :: a - integer, intent(out) :: info - integer, optional, intent(in) :: iunit - character(len=*), optional, intent(in) :: filename - character :: mmheader*15, fmt*15, object*10, type*10, sym*15 - character(1024) :: line - integer :: nrow, ncol, nnzero - integer :: ircode, i,nzr,infile - type(psb_d_coo_sparse_mat), allocatable :: acoo - - info = psb_success_ - - if (present(filename)) then - if (filename == '-') then - infile=5 - else - if (present(iunit)) then - infile=iunit - else - infile=99 - endif - open(infile,file=filename, status='OLD', err=901, action='READ') - endif - else - if (present(iunit)) then - infile=iunit - else - infile=5 - endif - endif - - read(infile,fmt=*,end=902) mmheader, object, fmt, type, sym - - if ( (psb_tolower(object) /= 'matrix').or.(psb_tolower(fmt) /= 'coordinate')) then - write(psb_err_unit,*) 'READ_MATRIX: input file type not yet supported' - info=909 - return - end if - - do - read(infile,fmt='(a)') line - if (line(1:1) /= '%') exit - end do - read(line,fmt=*) nrow,ncol,nnzero - - allocate(acoo, stat=ircode) - if (ircode /= 0) goto 993 - if ((psb_tolower(type) == 'real').and.(psb_tolower(sym) == 'general')) then - call acoo%allocate(nrow,ncol,nnzero) - do i=1,nnzero - read(infile,fmt=*,end=902) acoo%ia(i),acoo%ja(i),acoo%val(i) - end do - call acoo%set_nzeros(nnzero) - call acoo%fix(info) - - call a%mv_from(acoo) - call a%cscnv(ircode,type='csr') - - else if ((psb_tolower(type) == 'real').and.(psb_tolower(sym) == 'symmetric')) then - ! we are generally working with non-symmetric matrices, so - ! we de-symmetrize what we are about to read - call acoo%allocate(nrow,ncol,2*nnzero) - do i=1,nnzero - read(infile,fmt=*,end=902) acoo%ia(i),acoo%ja(i),acoo%val(i) - end do - nzr = nnzero - do i=1,nnzero - if (acoo%ia(i) /= acoo%ja(i)) then - nzr = nzr + 1 - acoo%val(nzr) = acoo%val(i) - acoo%ia(nzr) = acoo%ja(i) - acoo%ja(nzr) = acoo%ia(i) - end if - end do - call acoo%set_nzeros(nzr) - call acoo%fix(info) - - call a%mv_from(acoo) - call a%cscnv(ircode,type='csr') - - else - write(psb_err_unit,*) 'read_matrix: matrix type not yet supported' - info=904 - end if - if (infile /= 5) close(infile) - return - - ! open failed -901 info=901 - write(psb_err_unit,*) 'read_matrix: could not open file ',filename,' for input' - return -902 info=902 - write(psb_err_unit,*) 'READ_MATRIX: Unexpected end of file ' - return -993 info=993 - write(psb_err_unit,*) 'READ_MATRIX: Memory allocation failure' - return -end subroutine dmm_mat_read - - -subroutine dmm_mat_write(a,mtitle,info,iunit,filename) - use psb_base_mod - implicit none - type(psb_dspmat_type), intent(in) :: a - integer, intent(out) :: info - character(len=*), intent(in) :: mtitle - integer, optional, intent(in) :: iunit - character(len=*), optional, intent(in) :: filename - integer :: iout - - - info = psb_success_ - - if (present(filename)) then - if (filename == '-') then - iout=6 - else - if (present(iunit)) then - iout = iunit - else - iout=99 - endif - open(iout,file=filename, err=901, action='WRITE') - endif - else - if (present(iunit)) then - iout = iunit - else - iout=6 - endif - endif - - call a%print(iout,head=mtitle) - - if (iout /= 6) close(iout) - - - return - -901 continue - info=901 - write(psb_err_unit,*) 'Error while opening ',filename - return -end subroutine dmm_mat_write - -subroutine cmm_mat_read(a, info, iunit, filename) - use psb_base_mod - implicit none - type(psb_cspmat_type), intent(out) :: a - integer, intent(out) :: info - integer, optional, intent(in) :: iunit - character(len=*), optional, intent(in) :: filename - character :: mmheader*15, fmt*15, object*10, type*10, sym*15 - character(1024) :: line - integer :: nrow, ncol, nnzero - integer :: ircode, i,nzr,infile - type(psb_c_coo_sparse_mat), allocatable :: acoo - real(psb_spk_) :: are, aim - info = psb_success_ - - if (present(filename)) then - if (filename == '-') then - infile=5 - else - if (present(iunit)) then - infile=iunit - else - infile=99 - endif - open(infile,file=filename, status='OLD', err=901, action='READ') - endif - else - if (present(iunit)) then - infile=iunit - else - infile=5 - endif - endif - - read(infile,fmt=*,end=902) mmheader, object, fmt, type, sym - - if ( (psb_tolower(object) /= 'matrix').or.(psb_tolower(fmt) /= 'coordinate')) then - write(psb_err_unit,*) 'READ_MATRIX: input file type not yet supported' - info=909 - return - end if - - do - read(infile,fmt='(a)') line - if (line(1:1) /= '%') exit - end do - read(line,fmt=*) nrow,ncol,nnzero - - allocate(acoo, stat=ircode) - if (ircode /= 0) goto 993 - if ((psb_tolower(type) == 'complex').and.(psb_tolower(sym) == 'general')) then - call acoo%allocate(nrow,ncol,nnzero) - do i=1,nnzero - read(infile,fmt=*,end=902) acoo%ia(i),acoo%ja(i),are,aim - acoo%val(i) = cmplx(are,aim,kind=psb_spk_) - end do - call acoo%set_nzeros(nnzero) - call acoo%fix(info) - - call a%mv_from(acoo) - call a%cscnv(ircode,type='csr') - - else if ((psb_tolower(type) == 'complex').and.(psb_tolower(sym) == 'symmetric')) then - ! we are generally working with non-symmetric matrices, so - ! we de-symmetrize what we are about to read - call acoo%allocate(nrow,ncol,2*nnzero) - do i=1,nnzero - read(infile,fmt=*,end=902) acoo%ia(i),acoo%ja(i),are,aim - acoo%val(i) = cmplx(are,aim,kind=psb_spk_) - end do - nzr = nnzero - do i=1,nnzero - if (acoo%ia(i) /= acoo%ja(i)) then - nzr = nzr + 1 - acoo%val(nzr) = acoo%val(i) - acoo%ia(nzr) = acoo%ja(i) - acoo%ja(nzr) = acoo%ia(i) - end if - end do - call acoo%set_nzeros(nzr) - call acoo%fix(info) - - call a%mv_from(acoo) - call a%cscnv(ircode,type='csr') - - else if ((psb_tolower(type) == 'complex').and.(psb_tolower(sym) == 'hermitian')) then - ! we are generally working with non-symmetric matrices, so - ! we de-symmetrize what we are about to read - call acoo%allocate(nrow,ncol,2*nnzero) - do i=1,nnzero - read(infile,fmt=*,end=902) acoo%ia(i),acoo%ja(i),are,aim - acoo%val(i) = cmplx(are,aim,kind=psb_spk_) - end do - nzr = nnzero - do i=1,nnzero - if (acoo%ia(i) /= acoo%ja(i)) then - nzr = nzr + 1 - acoo%val(nzr) = conjg(acoo%val(i)) - acoo%ia(nzr) = acoo%ja(i) - acoo%ja(nzr) = acoo%ia(i) - end if - end do - call acoo%set_nzeros(nzr) - call acoo%fix(info) - - call a%mv_from(acoo) - call a%cscnv(ircode,type='csr') - - else - write(psb_err_unit,*) 'read_matrix: matrix type not yet supported' - info=904 - end if - if (infile /= 5) close(infile) - return - - ! open failed -901 info=901 - write(psb_err_unit,*) 'read_matrix: could not open file ',filename,' for input' - return -902 info=902 - write(psb_err_unit,*) 'READ_MATRIX: Unexpected end of file ' - return -993 info=993 - write(psb_err_unit,*) 'READ_MATRIX: Memory allocation failure' - return -end subroutine cmm_mat_read - - -subroutine cmm_mat_write(a,mtitle,info,iunit,filename) - use psb_base_mod - implicit none - type(psb_cspmat_type), intent(in) :: a - integer, intent(out) :: info - character(len=*), intent(in) :: mtitle - integer, optional, intent(in) :: iunit - character(len=*), optional, intent(in) :: filename - integer :: iout - - - info = psb_success_ - - if (present(filename)) then - if (filename == '-') then - iout=6 - else - if (present(iunit)) then - iout = iunit - else - iout=99 - endif - open(iout,file=filename, err=901, action='WRITE') - endif - else - if (present(iunit)) then - iout = iunit - else - iout=6 - endif - endif - - call a%print(iout,head=mtitle) - - if (iout /= 6) close(iout) - - - return - -901 continue - info=901 - write(psb_err_unit,*) 'Error while opening ',filename - return -end subroutine cmm_mat_write - -subroutine zmm_mat_read(a, info, iunit, filename) - use psb_base_mod - implicit none - type(psb_zspmat_type), intent(out) :: a - integer, intent(out) :: info - integer, optional, intent(in) :: iunit - character(len=*), optional, intent(in) :: filename - character :: mmheader*15, fmt*15, object*10, type*10, sym*15 - character(1024) :: line - integer :: nrow, ncol, nnzero - integer :: ircode, i,nzr,infile - type(psb_z_coo_sparse_mat), allocatable :: acoo - real(psb_dpk_) :: are, aim - info = psb_success_ - - if (present(filename)) then - if (filename == '-') then - infile=5 - else - if (present(iunit)) then - infile=iunit - else - infile=99 - endif - open(infile,file=filename, status='OLD', err=901, action='READ') - endif - else - if (present(iunit)) then - infile=iunit - else - infile=5 - endif - endif - - read(infile,fmt=*,end=902) mmheader, object, fmt, type, sym - - if ( (psb_tolower(object) /= 'matrix').or.(psb_tolower(fmt) /= 'coordinate')) then - write(psb_err_unit,*) 'READ_MATRIX: input file type not yet supported' - info=909 - return - end if - - do - read(infile,fmt='(a)') line - if (line(1:1) /= '%') exit - end do - read(line,fmt=*) nrow,ncol,nnzero - - allocate(acoo, stat=ircode) - if (ircode /= 0) goto 993 - if ((psb_tolower(type) == 'complex').and.(psb_tolower(sym) == 'general')) then - call acoo%allocate(nrow,ncol,nnzero) - do i=1,nnzero - read(infile,fmt=*,end=902) acoo%ia(i),acoo%ja(i),are,aim - acoo%val(i) = cmplx(are,aim,kind=psb_dpk_) - end do - call acoo%set_nzeros(nnzero) - call acoo%fix(info) - - call a%mv_from(acoo) - call a%cscnv(ircode,type='csr') - - else if ((psb_tolower(type) == 'complex').and.(psb_tolower(sym) == 'symmetric')) then - ! we are generally working with non-symmetric matrices, so - ! we de-symmetrize what we are about to read - call acoo%allocate(nrow,ncol,2*nnzero) - do i=1,nnzero - read(infile,fmt=*,end=902) acoo%ia(i),acoo%ja(i),are,aim - acoo%val(i) = cmplx(are,aim,kind=psb_dpk_) - end do - nzr = nnzero - do i=1,nnzero - if (acoo%ia(i) /= acoo%ja(i)) then - nzr = nzr + 1 - acoo%val(nzr) = acoo%val(i) - acoo%ia(nzr) = acoo%ja(i) - acoo%ja(nzr) = acoo%ia(i) - end if - end do - call acoo%set_nzeros(nzr) - call acoo%fix(info) - - call a%mv_from(acoo) - call a%cscnv(ircode,type='csr') - - else if ((psb_tolower(type) == 'complex').and.(psb_tolower(sym) == 'hermitian')) then - ! we are generally working with non-symmetric matrices, so - ! we de-symmetrize what we are about to read - call acoo%allocate(nrow,ncol,2*nnzero) - do i=1,nnzero - read(infile,fmt=*,end=902) acoo%ia(i),acoo%ja(i),are,aim - acoo%val(i) = cmplx(are,aim,kind=psb_dpk_) - end do - nzr = nnzero - do i=1,nnzero - if (acoo%ia(i) /= acoo%ja(i)) then - nzr = nzr + 1 - acoo%val(nzr) = conjg(acoo%val(i)) - acoo%ia(nzr) = acoo%ja(i) - acoo%ja(nzr) = acoo%ia(i) - end if - end do - call acoo%set_nzeros(nzr) - call acoo%fix(info) - - call a%mv_from(acoo) - call a%cscnv(ircode,type='csr') - - else - write(psb_err_unit,*) 'read_matrix: matrix type not yet supported' - info=904 - end if - if (infile /= 5) close(infile) - return - - ! open failed -901 info=901 - write(psb_err_unit,*) 'read_matrix: could not open file ',filename,' for input' - return -902 info=902 - write(psb_err_unit,*) 'READ_MATRIX: Unexpected end of file ' - return -993 info=993 - write(psb_err_unit,*) 'READ_MATRIX: Memory allocation failure' - return -end subroutine zmm_mat_read - - -subroutine zmm_mat_write(a,mtitle,info,iunit,filename) - use psb_base_mod - implicit none - type(psb_zspmat_type), intent(in) :: a - integer, intent(out) :: info - character(len=*), intent(in) :: mtitle - integer, optional, intent(in) :: iunit - character(len=*), optional, intent(in) :: filename - integer :: iout - - - info = psb_success_ - - if (present(filename)) then - if (filename == '-') then - iout=6 - else - if (present(iunit)) then - iout = iunit - else - iout=99 - endif - open(iout,file=filename, err=901, action='WRITE') - endif - else - if (present(iunit)) then - iout = iunit - else - iout=6 - endif - endif - - call a%print(iout,head=mtitle) - - if (iout /= 6) close(iout) - - - return - -901 continue - info=901 - write(psb_err_unit,*) 'Error while opening ',filename - return -end subroutine zmm_mat_write - - diff --git a/util/psb_renum_mod.f90 b/util/psb_renum_mod.f90 index 0bdcd7e9b..fa5de3669 100644 --- a/util/psb_renum_mod.f90 +++ b/util/psb_renum_mod.f90 @@ -5,12 +5,46 @@ module psb_renum_mod interface psb_mat_renum - subroutine psb_d_mat_renum(alg,mat,info) + subroutine psb_d_mat_renum(alg,mat,info,perm) import psb_dspmat_type integer, intent(in) :: alg type(psb_dspmat_type), intent(inout) :: mat integer, intent(out) :: info + integer, allocatable, optional, intent(out) :: perm(:) end subroutine psb_d_mat_renum + subroutine psb_s_mat_renum(alg,mat,info,perm) + import psb_sspmat_type + integer, intent(in) :: alg + type(psb_sspmat_type), intent(inout) :: mat + integer, intent(out) :: info + integer, allocatable, optional, intent(out) :: perm(:) + end subroutine psb_s_mat_renum + subroutine psb_z_mat_renum(alg,mat,info,perm) + import psb_zspmat_type + integer, intent(in) :: alg + type(psb_zspmat_type), intent(inout) :: mat + integer, intent(out) :: info + integer, allocatable, optional, intent(out) :: perm(:) + end subroutine psb_z_mat_renum + subroutine psb_c_mat_renum(alg,mat,info,perm) + import psb_cspmat_type + integer, intent(in) :: alg + type(psb_cspmat_type), intent(inout) :: mat + integer, intent(out) :: info + integer, allocatable, optional, intent(out) :: perm(:) + end subroutine psb_c_mat_renum end interface psb_mat_renum + + interface psb_cmp_bwpf + subroutine psb_d_cmp_bwpf(mat,bwl,bwu,prf,info) + import psb_dspmat_type + type(psb_dspmat_type), intent(in) :: mat + integer, intent(out) :: bwl, bwu + integer, intent(out) :: prf + integer, intent(out) :: info + end subroutine psb_d_cmp_bwpf + end interface psb_cmp_bwpf + + end module psb_renum_mod diff --git a/util/psb_s_hbio_impl.f90 b/util/psb_s_hbio_impl.f90 new file mode 100644 index 000000000..12969266f --- /dev/null +++ b/util/psb_s_hbio_impl.f90 @@ -0,0 +1,329 @@ +!!$ +!!$ Parallel Sparse BLAS version 3.0 +!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine shb_read(a, iret, iunit, filename,b,g,x,mtitle) + use psb_base_mod + implicit none + type(psb_sspmat_type), intent(out) :: a + integer, intent(out) :: iret + integer, optional, intent(in) :: iunit + character(len=*), optional, intent(in) :: filename + real(psb_spk_), optional, allocatable, intent(out) :: b(:,:), g(:,:), x(:,:) + character(len=72), optional, intent(out) :: mtitle + + character :: rhstype*3,type*3,key*8 + character(len=72) :: mtitle_ + character indfmt*16,ptrfmt*16,rhsfmt*20,valfmt*20 + integer :: indcrd, ptrcrd, totcrd,& + & valcrd, rhscrd, nrow, ncol, nnzero, neltvl, nrhs, nrhsix + type(psb_s_csc_sparse_mat) :: acsc + type(psb_s_coo_sparse_mat) :: acoo + integer :: ircode, i,nzr,infile, info + character(len=*), parameter :: fmt10='(a72,a8,/,5i14,/,a3,11x,4i14,/,2a16,2a20)' + character(len=*), parameter :: fmt11='(a3,11x,2i14)' + character(len=*), parameter :: fmt111='(1x,a8,1x,i8,1x,a10)' + + iret = 0 + ircode = 0 + if (present(filename)) then + if (filename == '-') then + infile=5 + else + if (present(iunit)) then + infile=iunit + else + infile=99 + endif + open(infile,file=filename, status='OLD', err=901, action='READ') + endif + else + if (present(iunit)) then + infile=iunit + else + infile=5 + endif + endif + + read (infile,fmt=fmt10) mtitle_,key,totcrd,ptrcrd,indcrd,valcrd,rhscrd,& + & type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt + if (rhscrd > 0) read(infile,fmt=fmt11)rhstype,nrhs,nrhsix + + call acsc%allocate(nrow,ncol,nnzero) + if (ircode /= 0 ) then + write(psb_err_unit,*) 'Memory allocation failed' + goto 993 + end if + + if (present(mtitle)) mtitle=mtitle_ + + + if (psb_tolower(type(1:1)) == 'r') then + if (psb_tolower(type(2:2)) == 'u') then + + + read (infile,fmt=ptrfmt) (acsc%icp(i),i=1,ncol+1) + read (infile,fmt=indfmt) (acsc%ia(i),i=1,nnzero) + if (valcrd > 0) read (infile,fmt=valfmt) (acsc%val(i),i=1,nnzero) + + call a%mv_from(acsc) + + if (present(b)) then + if ((psb_toupper(rhstype(1:1)) == 'F').and.(rhscrd > 0)) then + call psb_realloc(nrow,1,b,info) + read (infile,fmt=rhsfmt) (b(i,1),i=1,nrow) + endif + endif + if (present(g)) then + if ((psb_toupper(rhstype(2:2)) == 'G').and.(rhscrd > 0)) then + call psb_realloc(nrow,1,g,info) + read (infile,fmt=rhsfmt) (g(i,1),i=1,nrow) + endif + endif + if (present(x)) then + if ((psb_toupper(rhstype(3:3)) == 'X').and.(rhscrd > 0)) then + call psb_realloc(nrow,1,x,info) + read (infile,fmt=rhsfmt) (x(i,1),i=1,nrow) + endif + endif + + else if (psb_tolower(type(2:2)) == 's') then + + ! we are generally working with non-symmetric matrices, so + ! we de-symmetrize what we are about to read + + read (infile,fmt=ptrfmt) (acsc%icp(i),i=1,ncol+1) + read (infile,fmt=indfmt) (acsc%ia(i),i=1,nnzero) + if (valcrd > 0) read (infile,fmt=valfmt) (acsc%val(i),i=1,nnzero) + + + if (present(b)) then + if ((psb_toupper(rhstype(1:1)) == 'F').and.(rhscrd > 0)) then + call psb_realloc(nrow,1,b,info) + read (infile,fmt=rhsfmt) (b(i,1),i=1,nrow) + endif + endif + if (present(g)) then + if ((psb_toupper(rhstype(2:2)) == 'G').and.(rhscrd > 0)) then + call psb_realloc(nrow,1,g,info) + read (infile,fmt=rhsfmt) (g(i,1),i=1,nrow) + endif + endif + if (present(x)) then + if ((psb_toupper(rhstype(3:3)) == 'X').and.(rhscrd > 0)) then + call psb_realloc(nrow,1,x,info) + read (infile,fmt=rhsfmt) (x(i,1),i=1,nrow) + endif + endif + + + call acoo%mv_from_fmt(acsc,info) + call acoo%reallocate(2*nnzero) + ! A is now in COO format + nzr = nnzero + do i=1,nnzero + if (acoo%ia(i) /= acoo%ja(i)) then + nzr = nzr + 1 + acoo%val(nzr) = acoo%val(i) + acoo%ia(nzr) = acoo%ja(i) + acoo%ja(nzr) = acoo%ia(i) + end if + end do + call acoo%set_nzeros(nzr) + call acoo%fix(ircode) + if (ircode == 0) call a%mv_from(acoo) + if (ircode /= 0) goto 993 + + else + write(psb_err_unit,*) 'read_matrix: matrix type not yet supported' + iret=904 + end if + else + write(psb_err_unit,*) 'read_matrix: matrix type not yet supported' + iret=904 + end if + + call a%cscnv(ircode,type='csr') + if (infile /= 5) close(infile) + + return + + ! open failed +901 iret=901 + write(psb_err_unit,*) 'read_matrix: could not open file ',filename,' for input' + return +902 iret=902 + write(psb_err_unit,*) 'HB_READ: Unexpected end of file ' + return +993 iret=993 + write(psb_err_unit,*) 'HB_READ: Memory allocation failure' + return +end subroutine shb_read + +subroutine shb_write(a,iret,iunit,filename,key,rhs,g,x,mtitle) + use psb_base_mod + implicit none + type(psb_sspmat_type), intent(in), target :: a + integer, intent(out) :: iret + character(len=*), optional, intent(in) :: mtitle + integer, optional, intent(in) :: iunit + character(len=*), optional, intent(in) :: filename + character(len=*), optional, intent(in) :: key + real(psb_spk_), optional :: rhs(:), g(:), x(:) + integer :: iout + + character(len=*), parameter:: ptrfmt='(10I8)',indfmt='(10I8)' + integer, parameter :: jptr=10,jind=10 + character(len=*), parameter:: valfmt='(4E20.12)',rhsfmt='(4E20.12)' + integer, parameter :: jval=4,jrhs=4 + character(len=*), parameter :: fmt10='(a72,a8,/,5i14,/,a3,11x,4i14,/,2a16,2a20)' + character(len=*), parameter :: fmt11='(a3,11x,2i14)' + character(len=*), parameter :: fmt111='(1x,a8,1x,i8,1x,a10)' + + type(psb_s_csc_sparse_mat), target :: acsc + type(psb_s_csc_sparse_mat), pointer :: acpnt + character(len=72) :: mtitle_ + character(len=8) :: key_ + + character :: rhstype*3,type*3 + + integer :: i,indcrd,ptrcrd,rhscrd,totcrd,valcrd,& + & nrow,ncol,nnzero, neltvl, nrhs, nrhsix + + iret = 0 + + if (present(filename)) then + if (filename == '-') then + iout=6 + else + if (present(iunit)) then + iout = iunit + else + iout=99 + endif + open(iout,file=filename, err=901, action='WRITE') + endif + else + if (present(iunit)) then + iout = iunit + else + iout=6 + endif + endif + + if (present(mtitle)) then + mtitle_ = mtitle + else + mtitle_ = 'Temporary PSBLAS title ' + endif + if (present(key)) then + key_ = key + else + key_ = 'PSBMAT00' + endif + + + select type(aa=>a%a) + type is (psb_s_csc_sparse_mat) + + acpnt => aa + + class default + + call acsc%cp_from_fmt(aa, iret) + if (iret /= 0) return + acpnt => acsc + + end select + + + nrow = acpnt%get_nrows() + ncol = acpnt%get_ncols() + nnzero = acpnt%get_nzeros() + + neltvl = 0 + + ptrcrd = (ncol+1)/jptr + if (mod(ncol+1,jptr) > 0) ptrcrd = ptrcrd + 1 + indcrd = nnzero/jind + if (mod(nnzero,jind) > 0) indcrd = indcrd + 1 + valcrd = nnzero/jval + if (mod(nnzero,jval) > 0) valcrd = valcrd + 1 + rhstype = '' + if (present(rhs)) then + if (size(rhs) 0) rhscrd = rhscrd + 1 + endif + nrhs = 1 + rhstype(1:1) = 'F' + else + rhscrd = 0 + nrhs = 0 + end if + totcrd = ptrcrd + indcrd + valcrd + rhscrd + + nrhsix = nrhs*nrow + + if (present(g)) then + rhstype(2:2) = 'G' + end if + if (present(x)) then + rhstype(3:3) = 'X' + end if + type = 'RUA' + + write (iout,fmt=fmt10) mtitle_,key_,totcrd,ptrcrd,indcrd,valcrd,rhscrd,& + & type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt + if (rhscrd > 0) write (iout,fmt=fmt11) rhstype,nrhs,nrhsix + write (iout,fmt=ptrfmt) (acpnt%icp(i),i=1,ncol+1) + write (iout,fmt=indfmt) (acpnt%ia(i),i=1,nnzero) + if (valcrd > 0) write (iout,fmt=valfmt) (acpnt%val(i),i=1,nnzero) + if (rhscrd > 0) write (iout,fmt=rhsfmt) (rhs(i),i=1,nrow) + if (present(g).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (g(i),i=1,nrow) + if (present(x).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (x(i),i=1,nrow) + + + + + if (iout /= 6) close(iout) + + + return + +901 continue + iret=901 + write(psb_err_unit,*) 'Error while opening ',filename + return +end subroutine shb_write + + diff --git a/util/psb_s_mat_dist_impl.f90 b/util/psb_s_mat_dist_impl.f90 new file mode 100644 index 000000000..2824ed712 --- /dev/null +++ b/util/psb_s_mat_dist_impl.f90 @@ -0,0 +1,470 @@ +!!$ +!!$ Parallel Sparse BLAS version 3.0 +!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine smatdist(a_glob, a, ictxt, desc_a,& + & b_glob, b, info, parts, v, inroot,fmt,mold) + ! + ! an utility subroutine to distribute a matrix among processors + ! according to a user defined data distribution, using + ! sparse matrix subroutines. + ! + ! type(d_spmat) :: a_glob + ! on entry: this contains the global sparse matrix as follows: + ! a%fida == 'csr' + ! a%aspk for coefficient values + ! a%ia1 for column indices + ! a%ia2 for row pointers + ! a%m for number of global matrix rows + ! a%k for number of global matrix columns + ! on exit : undefined, with unassociated pointers. + ! + ! type(d_spmat) :: a + ! on entry: fresh variable. + ! on exit : this will contain the local sparse matrix. + ! + ! interface parts + ! ! .....user passed subroutine..... + ! subroutine parts(global_indx,n,np,pv,nv) + ! implicit none + ! integer, intent(in) :: global_indx, n, np + ! integer, intent(out) :: nv + ! integer, intent(out) :: pv(*) + ! + ! end subroutine parts + ! end interface + ! on entry: subroutine providing user defined data distribution. + ! for each global_indx the subroutine should return + ! the list pv of all processes owning the row with + ! that index; the list will contain nv entries. + ! usually nv=1; if nv >1 then we have an overlap in the data + ! distribution. + ! + ! integer :: ictxt + ! on entry: blacs context. + ! on exit : unchanged. + ! + ! type (desc_type) :: desc_a + ! on entry: fresh variable. + ! on exit : the updated array descriptor + ! + ! real(psb_dpk_), optional :: b_glob(:) + ! on entry: this contains right hand side. + ! on exit : + ! + ! real(psb_dpk_), allocatable, optional :: b(:) + ! on entry: fresh variable. + ! on exit : this will contain the local right hand side. + ! + ! integer, optional :: inroot + ! on entry: specifies processor holding a_glob. default: 0 + ! on exit : unchanged. + ! + use psb_base_mod + use psb_mat_mod + implicit none + + ! parameters + type(psb_sspmat_type) :: a_glob + real(psb_spk_) :: b_glob(:) + integer :: ictxt + type(psb_sspmat_type) :: a + type(psb_s_vect_type) :: b + type(psb_desc_type) :: desc_a + integer, intent(out) :: info + integer, optional :: inroot + character(len=5), optional :: fmt + class(psb_s_base_sparse_mat), optional :: mold + + integer :: v(:) + interface + subroutine parts(global_indx,n,np,pv,nv) + implicit none + integer, intent(in) :: global_indx, n, np + integer, intent(out) :: nv + integer, intent(out) :: pv(*) + end subroutine parts + end interface + optional :: parts, v + + ! local variables + logical :: use_parts, use_v + integer :: np, iam + integer :: length_row, i_count, j_count,& + & k_count, root, liwork, nrow, ncol, nnzero, nrhs,& + & i, ll, nz, isize, iproc, nnr, err, err_act, int_err(5) + integer, allocatable :: iwork(:) + integer, allocatable :: irow(:),icol(:) + real(psb_spk_), allocatable :: val(:) + integer, parameter :: nb=30 + real(psb_dpk_) :: t0, t1, t2, t3, t4, t5 + character(len=20) :: name, ch_err + + info = psb_success_ + err = 0 + name = 'mat_distf' + call psb_erractionsave(err_act) + + ! executable statements + if (present(inroot)) then + root = inroot + else + root = psb_root_ + end if + call psb_info(ictxt, iam, np) + if (iam == root) then + nrow = a_glob%get_nrows() + ncol = a_glob%get_ncols() + if (nrow /= ncol) then + write(psb_err_unit,*) 'a rectangular matrix ? ',nrow,ncol + info=-1 + call psb_errpush(info,name) + goto 9999 + endif + nnzero = a_glob%get_nzeros() + nrhs = 1 + endif + + use_parts = present(parts) + use_v = present(v) + if (count((/ use_parts, use_v /)) /= 1) then + info=psb_err_no_optional_arg_ + call psb_errpush(info,name,a_err=" v, parts") + goto 9999 + endif + + ! broadcast informations to other processors + call psb_bcast(ictxt,nrow, root) + call psb_bcast(ictxt,ncol, root) + call psb_bcast(ictxt,nnzero, root) + call psb_bcast(ictxt,nrhs, root) + liwork = max(np, nrow + ncol) + allocate(iwork(liwork), stat = info) + if (info /= psb_success_) then + info=psb_err_alloc_request_ + int_err(1)=liwork + call psb_errpush(info,name,i_err=int_err,a_err='integer') + goto 9999 + endif + if (iam == root) then + write (*, fmt = *) 'start matdist',root, size(iwork),& + &nrow, ncol, nnzero,nrhs + endif + if (use_parts) then + call psb_cdall(ictxt,desc_a,info,mg=nrow,parts=parts) + else if (use_v) then + call psb_cdall(ictxt,desc_a,info,vg=v) + else + info = -1 + end if + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_cdall' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + call psb_spall(a,desc_a,info,nnz=((nnzero+np-1)/np)) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_psspall' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + call psb_geall(b,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_psdsall' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + + + isize = 3*nb*max(((nnzero+nrow)/nrow),nb) + allocate(val(isize),irow(isize),icol(isize),stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='Allocate' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + i_count = 1 + + do while (i_count <= nrow) + + if (use_parts) then + call parts(i_count,nrow,np,iwork, length_row) + if (length_row == 1) then + j_count = i_count + iproc = iwork(1) + do + j_count = j_count + 1 + if (j_count-i_count >= nb) exit + if (j_count > nrow) exit + call parts(j_count,nrow,np,iwork, length_row) + if (length_row /= 1 ) exit + if (iwork(1) /= iproc ) exit + end do + end if + else + length_row = 1 + j_count = i_count + iproc = v(i_count) + + do + j_count = j_count + 1 + if (j_count-i_count >= nb) exit + if (j_count > nrow) exit + if (v(j_count) /= iproc ) exit + end do + end if + + if (length_row == 1) then + ! now we should insert rows i_count..j_count-1 + nnr = j_count - i_count + + if (iam == root) then + + ll = 0 + do i= i_count, j_count-1 + call a_glob%csget(i,i,nz,& + & irow,icol,val,info,nzin=ll,append=.true.) + if (info /= psb_success_) then + if (nz >min(size(irow(ll+1:)),size(icol(ll+1:)),size(val(ll+1:)))) then + write(psb_err_unit,*) 'Allocation failure? This should not happen!' + end if + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + ll = ll + nz + end do + + if (iproc == iam) then + call psb_spins(ll,irow,icol,val,a,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_spins' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + call psb_geins(nnr,(/(i,i=i_count,j_count-1)/),b_glob(i_count:j_count-1),& + & b,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_ins' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + else + call psb_snd(ictxt,nnr,iproc) + call psb_snd(ictxt,ll,iproc) + call psb_snd(ictxt,irow(1:ll),iproc) + call psb_snd(ictxt,icol(1:ll),iproc) + call psb_snd(ictxt,val(1:ll),iproc) + call psb_snd(ictxt,b_glob(i_count:j_count-1),iproc) + call psb_rcv(ictxt,ll,iproc) + endif + else if (iam /= root) then + + if (iproc == iam) then + call psb_rcv(ictxt,nnr,root) + call psb_rcv(ictxt,ll,root) + if (ll > size(irow)) then + write(psb_err_unit,*) iam,'need to reallocate ',ll + deallocate(val,irow,icol) + allocate(val(ll),irow(ll),icol(ll),stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='Allocate' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + endif + call psb_rcv(ictxt,irow(1:ll),root) + call psb_rcv(ictxt,icol(1:ll),root) + call psb_rcv(ictxt,val(1:ll),root) + call psb_rcv(ictxt,b_glob(i_count:i_count+nnr-1),root) + call psb_snd(ictxt,ll,root) + call psb_spins(ll,irow,icol,val,a,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psspins' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + call psb_geins(nnr,(/(i,i=i_count,i_count+nnr-1)/),& + & b_glob(i_count:i_count+nnr-1),b,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psdsins' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + endif + endif + + i_count = j_count + + else + + ! here processors are counted 1..np + do j_count = 1, length_row + k_count = iwork(j_count) + if (iam == root) then + + ll = 0 + do i= i_count, i_count + call a_glob%csget(i,i,nz,& + & irow,icol,val,info,nzin=ll,append=.true.) + if (info /= psb_success_) then + if (nz >min(size(irow(ll+1:)),size(icol(ll+1:)),size(val(ll+1:)))) then + write(psb_err_unit,*) 'Allocation failure? This should not happen!' + end if + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + ll = ll + nz + end do + + if (k_count == iam) then + + call psb_spins(ll,irow,icol,val,a,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psspins' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + call psb_geins(1,(/i_count/),b_glob(i_count:i_count),& + & b,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psdsins' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + else + call psb_snd(ictxt,ll,k_count) + call psb_snd(ictxt,irow(1:ll),k_count) + call psb_snd(ictxt,icol(1:ll),k_count) + call psb_snd(ictxt,val(1:ll),k_count) + call psb_snd(ictxt,b_glob(i_count),k_count) + call psb_rcv(ictxt,ll,k_count) + endif + else if (iam /= root) then + if (k_count == iam) then + call psb_rcv(ictxt,ll,root) + call psb_rcv(ictxt,irow(1:ll),root) + call psb_rcv(ictxt,icol(1:ll),root) + call psb_rcv(ictxt,val(1:ll),root) + call psb_rcv(ictxt,b_glob(i_count),root) + call psb_snd(ictxt,ll,root) + call psb_spins(ll,irow,icol,val,a,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psspins' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + call psb_geins(1,(/i_count/),b_glob(i_count:i_count),& + & b,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psdsins' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + endif + endif + end do + i_count = i_count + 1 + endif + end do + + call psb_barrier(ictxt) + t0 = psb_wtime() + call psb_cdasb(desc_a,info) + t1 = psb_wtime() + if(info /= psb_success_)then + info=psb_err_from_subroutine_ + ch_err='psb_cdasb' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + call psb_barrier(ictxt) + t2 = psb_wtime() + call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=fmt,mold=mold) + t3 = psb_wtime() + if(info /= psb_success_)then + info=psb_err_from_subroutine_ + ch_err='psb_spasb' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + + if (iam == root) then + write(psb_out_unit,*) 'descriptor assembly: ',t1-t0 + write(psb_out_unit,*) 'sparse matrix assembly: ',t3-t2 + end if + + call psb_geasb(b,desc_a,info) + if(info /= psb_success_)then + info=psb_err_from_subroutine_ + ch_err='psdsasb' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + deallocate(val,irow,icol,stat=info) + if(info /= psb_success_)then + info=psb_err_from_subroutine_ + ch_err='deallocate' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + deallocate(iwork) + if (iam == root) write (*, fmt = *) 'end matdist' + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end subroutine smatdist diff --git a/util/psb_s_mmio_impl.f90 b/util/psb_s_mmio_impl.f90 new file mode 100644 index 000000000..7841badc0 --- /dev/null +++ b/util/psb_s_mmio_impl.f90 @@ -0,0 +1,364 @@ +!!$ +!!$ Parallel Sparse BLAS version 3.0 +!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine mm_svet_read(b, info, iunit, filename) + use psb_base_mod + implicit none + real(psb_spk_), allocatable, intent(out) :: b(:,:) + integer, intent(out) :: info + integer, optional, intent(in) :: iunit + character(len=*), optional, intent(in) :: filename + integer :: nrow, ncol, i,root, np, me, ircode, j,infile + character :: mmheader*15, fmt*15, object*10, type*10, sym*15,& + & line*1024 + + info = psb_success_ + if (present(filename)) then + if (filename == '-') then + infile=5 + else + if (present(iunit)) then + infile=iunit + else + infile=99 + endif + open(infile,file=filename, status='OLD', err=901, action='READ') + endif + else + if (present(iunit)) then + infile=iunit + else + infile=5 + endif + endif + + read(infile,fmt=*, end=902) mmheader, object, fmt, type, sym + + if ( (object /= 'matrix').or.(fmt /= 'array')) then + write(psb_err_unit,*) 'read_rhs: input file type not yet supported' + info = -3 + return + end if + + do + read(infile,fmt='(a)') line + if (line(1:1) /= '%') exit + end do + + read(line,fmt=*)nrow,ncol + + if ((psb_tolower(type) == 'real').and.(psb_tolower(sym) == 'general')) then + allocate(b(nrow,ncol),stat = ircode) + if (ircode /= 0) goto 993 + read(infile,fmt=*,end=902) ((b(i,j), i=1,nrow),j=1,ncol) + + end if ! read right hand sides + + if (infile /= 5) close(infile) + + return + ! open failed +901 write(psb_err_unit,*) 'mm_vet_read: could not open file ',& + & infile,' for input' + info = -1 + return + +902 write(psb_err_unit,*) 'mmv_vet_read: unexpected end of file ',infile,& + & ' during input' + info = -2 + return +993 write(psb_err_unit,*) 'mm_vet_read: memory allocation failure' + info = -3 + return +end subroutine mm_svet_read + +subroutine mm_svet2_write(b, header, info, iunit, filename) + use psb_base_mod + implicit none + real(psb_spk_), intent(in) :: b(:,:) + character(len=*), intent(in) :: header + integer, intent(out) :: info + integer, optional, intent(in) :: iunit + character(len=*), optional, intent(in) :: filename + integer :: nrow, ncol, i,root, np, me, ircode, j, outfile + + character(len=80) :: frmtv + + info = psb_success_ + if (present(filename)) then + if (filename == '-') then + outfile=6 + else + if (present(iunit)) then + outfile=iunit + else + outfile=99 + endif + open(outfile,file=filename, err=901, action='WRITE') + endif + else + if (present(iunit)) then + outfile=iunit + else + outfile=6 + endif + endif + + write(outfile,'(a)') '%%MatrixMarket matrix array real general' + write(outfile,'(a)') '% '//trim(header) + write(outfile,'(a)') '% ' + nrow = size(b,1) + ncol = size(b,2) + write(outfile,*) nrow,ncol + + write(frmtv,'(a,i3.3,a)') '(',ncol,'(es26.18,1x))' + + do i=1,size(b,1) + write(outfile,frmtv) b(i,1:ncol) + end do + + if (outfile /= 6) close(outfile) + + return + ! open failed +901 write(psb_err_unit,*) 'mm_vet_write: could not open file ',& + & outfile,' for output' + info = -1 + return + +end subroutine mm_svet2_write + +subroutine mm_svet1_write(b, header, info, iunit, filename) + use psb_base_mod + implicit none + real(psb_spk_), intent(in) :: b(:) + character(len=*), intent(in) :: header + integer, intent(out) :: info + integer, optional, intent(in) :: iunit + character(len=*), optional, intent(in) :: filename + integer :: nrow, ncol, i,root, np, me, ircode, j, outfile + + character(len=80) :: frmtv + + info = psb_success_ + if (present(filename)) then + if (filename == '-') then + outfile=6 + else + if (present(iunit)) then + outfile=iunit + else + outfile=99 + endif + open(outfile,file=filename, err=901, action='WRITE') + endif + else + if (present(iunit)) then + outfile=iunit + else + outfile=6 + endif + endif + + write(outfile,'(a)') '%%MatrixMarket matrix array real general' + write(outfile,'(a)') '% '//trim(header) + write(outfile,'(a)') '% ' + nrow = size(b,1) + ncol = 1 + write(outfile,*) nrow,ncol + + write(frmtv,'(a,i3.3,a)') '(',ncol,'(es26.18,1x))' + + do i=1,size(b,1) + write(outfile,frmtv) b(i) + end do + + if (outfile /= 6) close(outfile) + + return + ! open failed +901 write(psb_err_unit,*) 'mm_vet_write: could not open file ',& + & outfile,' for output' + info = -1 + return + +end subroutine mm_svet1_write + + +subroutine smm_mat_read(a, info, iunit, filename) + use psb_base_mod + implicit none + type(psb_sspmat_type), intent(out) :: a + integer, intent(out) :: info + integer, optional, intent(in) :: iunit + character(len=*), optional, intent(in) :: filename + character :: mmheader*15, fmt*15, object*10, type*10, sym*15 + character(1024) :: line + integer :: nrow, ncol, nnzero + integer :: ircode, i,nzr,infile + type(psb_s_coo_sparse_mat), allocatable :: acoo + + info = psb_success_ + + if (present(filename)) then + if (filename == '-') then + infile=5 + else + if (present(iunit)) then + infile=iunit + else + infile=99 + endif + open(infile,file=filename, status='OLD', err=901, action='READ') + endif + else + if (present(iunit)) then + infile=iunit + else + infile=5 + endif + endif + + read(infile,fmt=*,end=902) mmheader, object, fmt, type, sym + + if ( (psb_tolower(object) /= 'matrix').or.(psb_tolower(fmt) /= 'coordinate')) then + write(psb_err_unit,*) 'READ_MATRIX: input file type not yet supported' + info=909 + return + end if + + do + read(infile,fmt='(a)') line + if (line(1:1) /= '%') exit + end do + read(line,fmt=*) nrow,ncol,nnzero + + allocate(acoo, stat=ircode) + if (ircode /= 0) goto 993 + if ((psb_tolower(type) == 'real').and.(psb_tolower(sym) == 'general')) then + call acoo%allocate(nrow,ncol,nnzero) + do i=1,nnzero + read(infile,fmt=*,end=902) acoo%ia(i),acoo%ja(i),acoo%val(i) + end do + call acoo%set_nzeros(nnzero) + call acoo%fix(info) + + call a%mv_from(acoo) + call a%cscnv(ircode,type='csr') + + else if ((psb_tolower(type) == 'real').and.(psb_tolower(sym) == 'symmetric')) then + ! we are generally working with non-symmetric matrices, so + ! we de-symmetrize what we are about to read + call acoo%allocate(nrow,ncol,2*nnzero) + do i=1,nnzero + read(infile,fmt=*,end=902) acoo%ia(i),acoo%ja(i),acoo%val(i) + end do + nzr = nnzero + do i=1,nnzero + if (acoo%ia(i) /= acoo%ja(i)) then + nzr = nzr + 1 + acoo%val(nzr) = acoo%val(i) + acoo%ia(nzr) = acoo%ja(i) + acoo%ja(nzr) = acoo%ia(i) + end if + end do + call acoo%set_nzeros(nzr) + call acoo%fix(info) + + call a%mv_from(acoo) + call a%cscnv(ircode,type='csr') + + else + write(psb_err_unit,*) 'read_matrix: matrix type not yet supported' + info=904 + end if + + + if (infile /= 5) close(infile) + return + + ! open failed +901 info=901 + write(psb_err_unit,*) 'read_matrix: could not open file ',filename,' for input' + return +902 info=902 + write(psb_err_unit,*) 'READ_MATRIX: Unexpected end of file ' + return +993 info=993 + write(psb_err_unit,*) 'READ_MATRIX: Memory allocation failure' + return +end subroutine smm_mat_read + + +subroutine smm_mat_write(a,mtitle,info,iunit,filename) + use psb_base_mod + implicit none + type(psb_sspmat_type), intent(in) :: a + integer, intent(out) :: info + character(len=*), intent(in) :: mtitle + integer, optional, intent(in) :: iunit + character(len=*), optional, intent(in) :: filename + integer :: iout + + + info = psb_success_ + + if (present(filename)) then + if (filename == '-') then + iout=6 + else + if (present(iunit)) then + iout = iunit + else + iout=99 + endif + open(iout,file=filename, err=901, action='WRITE') + endif + else + if (present(iunit)) then + iout = iunit + else + iout=6 + endif + endif + + call a%print(iout,head=mtitle) + + if (iout /= 6) close(iout) + + + return + +901 continue + info=901 + write(psb_err_unit,*) 'Error while opening ',filename + return +end subroutine smm_mat_write diff --git a/util/psb_s_renum_impl.F90 b/util/psb_s_renum_impl.F90 new file mode 100644 index 000000000..2f0d83359 --- /dev/null +++ b/util/psb_s_renum_impl.F90 @@ -0,0 +1,142 @@ +subroutine psb_s_mat_renum(alg,mat,info,perm) + use psb_base_mod + use psb_renum_mod, psb_protect_name => psb_s_mat_renum + implicit none + integer, intent(in) :: alg + type(psb_sspmat_type), intent(inout) :: mat + integer, intent(out) :: info + integer, allocatable, optional, intent(out) :: perm(:) + + integer :: err_act + character(len=20) :: name + + info = psb_success_ + name = 'mat_renum' + call psb_erractionsave(err_act) + + info = psb_success_ + + select case (alg) + case(psb_mat_renum_gps_) + + call psb_mat_renum_gps(mat,info,perm) + + case default + info = psb_err_input_value_invalid_i_ + call psb_errpush(info,name,i_err=(/1,alg,0,0,0/)) + goto 9999 + end select + + if (info /= psb_success_) then + info = psb_err_from_subroutine_non_ + 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 psb_mat_renum_gps(a,info,operm) + use psb_base_mod + use psb_gps_mod + implicit none + type(psb_sspmat_type), intent(inout) :: a + integer, intent(out) :: info + integer, allocatable, optional, intent(out) :: operm(:) + + ! + class(psb_s_base_sparse_mat), allocatable :: aa + type(psb_s_csr_sparse_mat) :: acsr + type(psb_s_coo_sparse_mat) :: acoo + + integer :: err_act + character(len=20) :: name + integer, allocatable :: ndstk(:,:), iold(:), ndeg(:), perm(:) + integer :: i, j, k, ideg, nr, ibw, ipf, idpth + + info = psb_success_ + name = 'mat_renum' + call psb_erractionsave(err_act) + + info = psb_success_ + + call a%mold(aa) + call a%mv_to(aa) + call aa%mv_to_fmt(acsr,info) + ! Insert call to gps_reduce + nr = acsr%get_nrows() + ideg = 0 + do i=1, nr + ideg = max(ideg,acsr%irp(i+1)-acsr%irp(i)) + end do + allocate(ndstk(nr,ideg), iold(nr), perm(nr+1), ndeg(nr),stat=info) + if (info /= 0) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info, name) + goto 9999 + end if + do i=1, nr + iold(i) = i + ndstk(i,:) = 0 + k = 0 + do j=acsr%irp(i),acsr%irp(i+1)-1 + k = k + 1 + ndstk(i,k) = acsr%ja(j) + end do + end do + perm = 0 + + call psb_gps_reduce(ndstk,nr,ideg,iold,perm,ndeg,ibw,ipf,idpth) + + if (.not.psb_isaperm(nr,perm)) then + write(0,*) 'Something wrong: bad perm from gps_reduce' + info = psb_err_from_subroutine_ + call psb_errpush(info,name) + goto 9999 + end if + ! Move to coordinate to apply renumbering + call acsr%mv_to_coo(acoo,info) + do i=1, acoo%get_nzeros() + acoo%ia(i) = perm(acoo%ia(i)) + acoo%ja(i) = perm(acoo%ja(i)) + end do + call acoo%fix(info) + + ! Get back to where we started from + call aa%mv_from_coo(acoo,info) + call a%mv_from(aa) + if (present(operm)) then + call psb_realloc(nr,operm,info) + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + end if + operm(1:nr) = perm(1:nr) + end if + + deallocate(aa) + 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 psb_mat_renum_gps + +end subroutine psb_s_mat_renum + diff --git a/util/psb_z_hbio_impl.f90 b/util/psb_z_hbio_impl.f90 new file mode 100644 index 000000000..ea1121fec --- /dev/null +++ b/util/psb_z_hbio_impl.f90 @@ -0,0 +1,375 @@ +!!$ +!!$ Parallel Sparse BLAS version 3.0 +!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine zhb_read(a, iret, iunit, filename,b,g,x,mtitle) + use psb_base_mod + implicit none + type(psb_zspmat_type), intent(out) :: a + integer, intent(out) :: iret + integer, optional, intent(in) :: iunit + character(len=*), optional, intent(in) :: filename + complex(psb_dpk_), optional, allocatable, intent(out) :: b(:,:), g(:,:), x(:,:) + character(len=72), optional, intent(out) :: mtitle + + character :: rhstype*3,type*3,key*8 + character(len=72) :: mtitle_ + character indfmt*16,ptrfmt*16,rhsfmt*20,valfmt*20 + integer :: indcrd, ptrcrd, totcrd,& + & valcrd, rhscrd, nrow, ncol, nnzero, neltvl, nrhs, nrhsix + type(psb_z_csc_sparse_mat) :: acsc + type(psb_z_coo_sparse_mat) :: acoo + integer :: ircode, i,nzr,infile, info + character(len=*), parameter :: fmt10='(a72,a8,/,5i14,/,a3,11x,4i14,/,2a16,2a20)' + character(len=*), parameter :: fmt11='(a3,11x,2i14)' + character(len=*), parameter :: fmt111='(1x,a8,1x,i8,1x,a10)' + + iret = 0 + ircode = 0 + if (present(filename)) then + if (filename == '-') then + infile=5 + else + if (present(iunit)) then + infile=iunit + else + infile=99 + endif + open(infile,file=filename, status='OLD', err=901, action='READ') + endif + else + if (present(iunit)) then + infile=iunit + else + infile=5 + endif + endif + + read (infile,fmt=fmt10) mtitle_,key,totcrd,ptrcrd,indcrd,valcrd,rhscrd,& + & type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt + if (rhscrd > 0) read(infile,fmt=fmt11)rhstype,nrhs,nrhsix + + call acsc%allocate(nrow,ncol,nnzero) + if (ircode /= 0 ) then + write(psb_err_unit,*) 'Memory allocation failed' + goto 993 + end if + + if (present(mtitle)) mtitle=mtitle_ + + + if (psb_tolower(type(1:1)) == 'c') then + if (psb_tolower(type(2:2)) == 'u') then + + + read (infile,fmt=ptrfmt) (acsc%icp(i),i=1,ncol+1) + read (infile,fmt=indfmt) (acsc%ia(i),i=1,nnzero) + if (valcrd > 0) read (infile,fmt=valfmt) (acsc%val(i),i=1,nnzero) + + call a%mv_from(acsc) + + if (present(b)) then + if ((psb_toupper(rhstype(1:1)) == 'F').and.(rhscrd > 0)) then + call psb_realloc(nrow,1,b,info) + read (infile,fmt=rhsfmt) (b(i,1),i=1,nrow) + endif + endif + if (present(g)) then + if ((psb_toupper(rhstype(2:2)) == 'G').and.(rhscrd > 0)) then + call psb_realloc(nrow,1,g,info) + read (infile,fmt=rhsfmt) (g(i,1),i=1,nrow) + endif + endif + if (present(x)) then + if ((psb_toupper(rhstype(3:3)) == 'X').and.(rhscrd > 0)) then + call psb_realloc(nrow,1,x,info) + read (infile,fmt=rhsfmt) (x(i,1),i=1,nrow) + endif + endif + + else if (psb_tolower(type(2:2)) == 's') then + + ! we are generally working with non-symmetric matrices, so + ! we de-symmetrize what we are about to read + + read (infile,fmt=ptrfmt) (acsc%icp(i),i=1,ncol+1) + read (infile,fmt=indfmt) (acsc%ia(i),i=1,nnzero) + if (valcrd > 0) read (infile,fmt=valfmt) (acsc%val(i),i=1,nnzero) + + + if (present(b)) then + if ((psb_toupper(rhstype(1:1)) == 'F').and.(rhscrd > 0)) then + call psb_realloc(nrow,1,b,info) + read (infile,fmt=rhsfmt) (b(i,1),i=1,nrow) + endif + endif + if (present(g)) then + if ((psb_toupper(rhstype(2:2)) == 'G').and.(rhscrd > 0)) then + call psb_realloc(nrow,1,g,info) + read (infile,fmt=rhsfmt) (g(i,1),i=1,nrow) + endif + endif + if (present(x)) then + if ((psb_toupper(rhstype(3:3)) == 'X').and.(rhscrd > 0)) then + call psb_realloc(nrow,1,x,info) + read (infile,fmt=rhsfmt) (x(i,1),i=1,nrow) + endif + endif + + + call acoo%mv_from_fmt(acsc,info) + call acoo%reallocate(2*nnzero) + ! A is now in COO format + nzr = nnzero + do i=1,nnzero + if (acoo%ia(i) /= acoo%ja(i)) then + nzr = nzr + 1 + acoo%val(nzr) = acoo%val(i) + acoo%ia(nzr) = acoo%ja(i) + acoo%ja(nzr) = acoo%ia(i) + end if + end do + call acoo%set_nzeros(nzr) + call acoo%fix(ircode) + if (ircode == 0) call a%mv_from(acoo) + if (ircode /= 0) goto 993 + + else if (psb_tolower(type(2:2)) == 'h') then + + ! we are generally working with non-symmetric matrices, so + ! we de-symmetrize what we are about to read + + read (infile,fmt=ptrfmt) (acsc%icp(i),i=1,ncol+1) + read (infile,fmt=indfmt) (acsc%ia(i),i=1,nnzero) + if (valcrd > 0) read (infile,fmt=valfmt) (acsc%val(i),i=1,nnzero) + + + if (present(b)) then + if ((psb_toupper(rhstype(1:1)) == 'F').and.(rhscrd > 0)) then + call psb_realloc(nrow,1,b,info) + read (infile,fmt=rhsfmt) (b(i,1),i=1,nrow) + endif + endif + if (present(g)) then + if ((psb_toupper(rhstype(2:2)) == 'G').and.(rhscrd > 0)) then + call psb_realloc(nrow,1,g,info) + read (infile,fmt=rhsfmt) (g(i,1),i=1,nrow) + endif + endif + if (present(x)) then + if ((psb_toupper(rhstype(3:3)) == 'X').and.(rhscrd > 0)) then + call psb_realloc(nrow,1,x,info) + read (infile,fmt=rhsfmt) (x(i,1),i=1,nrow) + endif + endif + + + call acoo%mv_from_fmt(acsc,info) + call acoo%reallocate(2*nnzero) + ! A is now in COO format + nzr = nnzero + do i=1,nnzero + if (acoo%ia(i) /= acoo%ja(i)) then + nzr = nzr + 1 + acoo%val(nzr) = conjg(acoo%val(i)) + acoo%ia(nzr) = acoo%ja(i) + acoo%ja(nzr) = acoo%ia(i) + end if + end do + call acoo%set_nzeros(nzr) + call acoo%fix(ircode) + if (ircode == 0) call a%mv_from(acoo) + if (ircode /= 0) goto 993 + + else + write(psb_err_unit,*) 'read_matrix: matrix type not yet supported' + iret=904 + end if + else + write(psb_err_unit,*) 'read_matrix: matrix type not yet supported' + iret=904 + end if + + call a%cscnv(ircode,type='csr') + if (infile /= 5) close(infile) + + return + + ! open failed +901 iret=901 + write(psb_err_unit,*) 'read_matrix: could not open file ',filename,' for input' + return +902 iret=902 + write(psb_err_unit,*) 'HB_READ: Unexpected end of file ' + return +993 iret=993 + write(psb_err_unit,*) 'HB_READ: Memory allocation failure' + return +end subroutine zhb_read + +subroutine zhb_write(a,iret,iunit,filename,key,rhs,g,x,mtitle) + use psb_base_mod + implicit none + type(psb_zspmat_type), intent(in), target :: a + integer, intent(out) :: iret + character(len=*), optional, intent(in) :: mtitle + integer, optional, intent(in) :: iunit + character(len=*), optional, intent(in) :: filename + character(len=*), optional, intent(in) :: key + complex(psb_dpk_), optional :: rhs(:), g(:), x(:) + integer :: iout + + character(len=*), parameter:: ptrfmt='(10I8)',indfmt='(10I8)' + integer, parameter :: jptr=10,jind=10 + character(len=*), parameter:: valfmt='(4E20.12)',rhsfmt='(4E20.12)' + integer, parameter :: jval=2,jrhs=2 + character(len=*), parameter :: fmt10='(a72,a8,/,5i14,/,a3,11x,4i14,/,2a16,2a20)' + character(len=*), parameter :: fmt11='(a3,11x,2i14)' + character(len=*), parameter :: fmt111='(1x,a8,1x,i8,1x,a10)' + + type(psb_z_csc_sparse_mat), target :: acsc + type(psb_z_csc_sparse_mat), pointer :: acpnt + character(len=72) :: mtitle_ + character(len=8) :: key_ + + character :: rhstype*3,type*3 + + integer :: i,indcrd,ptrcrd,rhscrd,totcrd,valcrd,& + & nrow,ncol,nnzero, neltvl, nrhs, nrhsix + + iret = 0 + + if (present(filename)) then + if (filename == '-') then + iout=6 + else + if (present(iunit)) then + iout = iunit + else + iout=99 + endif + open(iout,file=filename, err=901, action='WRITE') + endif + else + if (present(iunit)) then + iout = iunit + else + iout=6 + endif + endif + + if (present(mtitle)) then + mtitle_ = mtitle + else + mtitle_ = 'Temporary PSBLAS title ' + endif + if (present(key)) then + key_ = key + else + key_ = 'PSBMAT00' + endif + + + select type(aa=>a%a) + type is (psb_z_csc_sparse_mat) + + acpnt => aa + + class default + + call acsc%cp_from_fmt(aa, iret) + if (iret /= 0) return + acpnt => acsc + + end select + + + nrow = acpnt%get_nrows() + ncol = acpnt%get_ncols() + nnzero = acpnt%get_nzeros() + + neltvl = 0 + + ptrcrd = (ncol+1)/jptr + if (mod(ncol+1,jptr) > 0) ptrcrd = ptrcrd + 1 + indcrd = nnzero/jind + if (mod(nnzero,jind) > 0) indcrd = indcrd + 1 + valcrd = nnzero/jval + if (mod(nnzero,jval) > 0) valcrd = valcrd + 1 + rhstype = '' + if (present(rhs)) then + if (size(rhs) 0) rhscrd = rhscrd + 1 + endif + nrhs = 1 + rhstype(1:1) = 'F' + else + rhscrd = 0 + nrhs = 0 + end if + totcrd = ptrcrd + indcrd + valcrd + rhscrd + + nrhsix = nrhs*nrow + + if (present(g)) then + rhstype(2:2) = 'G' + end if + if (present(x)) then + rhstype(3:3) = 'X' + end if + type = 'CUA' + + write (iout,fmt=fmt10) mtitle_,key_,totcrd,ptrcrd,indcrd,valcrd,rhscrd,& + & type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt + if (rhscrd > 0) write (iout,fmt=fmt11) rhstype,nrhs,nrhsix + write (iout,fmt=ptrfmt) (acpnt%icp(i),i=1,ncol+1) + write (iout,fmt=indfmt) (acpnt%ia(i),i=1,nnzero) + if (valcrd > 0) write (iout,fmt=valfmt) (acpnt%val(i),i=1,nnzero) + if (rhscrd > 0) write (iout,fmt=rhsfmt) (rhs(i),i=1,nrow) + if (present(g).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (g(i),i=1,nrow) + if (present(x).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (x(i),i=1,nrow) + + + + + if (iout /= 6) close(iout) + + + return + +901 continue + iret=901 + write(psb_err_unit,*) 'Error while opening ',filename + return +end subroutine zhb_write + diff --git a/util/psb_z_mat_dist_impl.f90 b/util/psb_z_mat_dist_impl.f90 new file mode 100644 index 000000000..8c294fdf8 --- /dev/null +++ b/util/psb_z_mat_dist_impl.f90 @@ -0,0 +1,470 @@ +!!$ +!!$ Parallel Sparse BLAS version 3.0 +!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine zmatdist(a_glob, a, ictxt, desc_a,& + & b_glob, b, info, parts, v, inroot,fmt,mold) + ! + ! an utility subroutine to distribute a matrix among processors + ! according to a user defined data distribution, using + ! sparse matrix subroutines. + ! + ! type(d_spmat) :: a_glob + ! on entry: this contains the global sparse matrix as follows: + ! a%fida == 'csr' + ! a%aspk for coefficient values + ! a%ia1 for column indices + ! a%ia2 for row pointers + ! a%m for number of global matrix rows + ! a%k for number of global matrix columns + ! on exit : undefined, with unassociated pointers. + ! + ! type(d_spmat) :: a + ! on entry: fresh variable. + ! on exit : this will contain the local sparse matrix. + ! + ! interface parts + ! ! .....user passed subroutine..... + ! subroutine parts(global_indx,n,np,pv,nv) + ! implicit none + ! integer, intent(in) :: global_indx, n, np + ! integer, intent(out) :: nv + ! integer, intent(out) :: pv(*) + ! + ! end subroutine parts + ! end interface + ! on entry: subroutine providing user defined data distribution. + ! for each global_indx the subroutine should return + ! the list pv of all processes owning the row with + ! that index; the list will contain nv entries. + ! usually nv=1; if nv >1 then we have an overlap in the data + ! distribution. + ! + ! integer :: ictxt + ! on entry: blacs context. + ! on exit : unchanged. + ! + ! type (desc_type) :: desc_a + ! on entry: fresh variable. + ! on exit : the updated array descriptor + ! + ! real(psb_dpk_), optional :: b_glob(:) + ! on entry: this contains right hand side. + ! on exit : + ! + ! real(psb_dpk_), allocatable, optional :: b(:) + ! on entry: fresh variable. + ! on exit : this will contain the local right hand side. + ! + ! integer, optional :: inroot + ! on entry: specifies processor holding a_glob. default: 0 + ! on exit : unchanged. + ! + use psb_base_mod + use psb_mat_mod + implicit none + + ! parameters + type(psb_zspmat_type) :: a_glob + complex(psb_dpk_) :: b_glob(:) + integer :: ictxt + type(psb_zspmat_type) :: a + type(psb_z_vect_type) :: b + type(psb_desc_type) :: desc_a + integer, intent(out) :: info + integer, optional :: inroot + character(len=5), optional :: fmt + class(psb_z_base_sparse_mat), optional :: mold + + integer :: v(:) + interface + subroutine parts(global_indx,n,np,pv,nv) + implicit none + integer, intent(in) :: global_indx, n, np + integer, intent(out) :: nv + integer, intent(out) :: pv(*) + end subroutine parts + end interface + optional :: parts, v + + ! local variables + logical :: use_parts, use_v + integer :: np, iam + integer :: length_row, i_count, j_count,& + & k_count, root, liwork, nrow, ncol, nnzero, nrhs,& + & i, ll, nz, isize, iproc, nnr, err, err_act, int_err(5) + integer, allocatable :: iwork(:) + integer, allocatable :: irow(:),icol(:) + complex(psb_dpk_), allocatable :: val(:) + integer, parameter :: nb=30 + real(psb_dpk_) :: t0, t1, t2, t3, t4, t5 + character(len=20) :: name, ch_err + + info = psb_success_ + err = 0 + name = 'mat_distf' + call psb_erractionsave(err_act) + + ! executable statements + if (present(inroot)) then + root = inroot + else + root = psb_root_ + end if + call psb_info(ictxt, iam, np) + if (iam == root) then + nrow = a_glob%get_nrows() + ncol = a_glob%get_ncols() + if (nrow /= ncol) then + write(psb_err_unit,*) 'a rectangular matrix ? ',nrow,ncol + info=-1 + call psb_errpush(info,name) + goto 9999 + endif + nnzero = a_glob%get_nzeros() + nrhs = 1 + endif + + use_parts = present(parts) + use_v = present(v) + if (count((/ use_parts, use_v /)) /= 1) then + info=psb_err_no_optional_arg_ + call psb_errpush(info,name,a_err=" v, parts") + goto 9999 + endif + + ! broadcast informations to other processors + call psb_bcast(ictxt,nrow, root) + call psb_bcast(ictxt,ncol, root) + call psb_bcast(ictxt,nnzero, root) + call psb_bcast(ictxt,nrhs, root) + liwork = max(np, nrow + ncol) + allocate(iwork(liwork), stat = info) + if (info /= psb_success_) then + info=psb_err_alloc_request_ + int_err(1)=liwork + call psb_errpush(info,name,i_err=int_err,a_err='integer') + goto 9999 + endif + if (iam == root) then + write (*, fmt = *) 'start matdist',root, size(iwork),& + &nrow, ncol, nnzero,nrhs + endif + if (use_parts) then + call psb_cdall(ictxt,desc_a,info,mg=nrow,parts=parts) + else if (use_v) then + call psb_cdall(ictxt,desc_a,info,vg=v) + else + info = -1 + end if + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_cdall' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + call psb_spall(a,desc_a,info,nnz=((nnzero+np-1)/np)) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_psspall' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + call psb_geall(b,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_psdsall' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + + + isize = 3*nb*max(((nnzero+nrow)/nrow),nb) + allocate(val(isize),irow(isize),icol(isize),stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='Allocate' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + i_count = 1 + + do while (i_count <= nrow) + + if (use_parts) then + call parts(i_count,nrow,np,iwork, length_row) + if (length_row == 1) then + j_count = i_count + iproc = iwork(1) + do + j_count = j_count + 1 + if (j_count-i_count >= nb) exit + if (j_count > nrow) exit + call parts(j_count,nrow,np,iwork, length_row) + if (length_row /= 1 ) exit + if (iwork(1) /= iproc ) exit + end do + end if + else + length_row = 1 + j_count = i_count + iproc = v(i_count) + + do + j_count = j_count + 1 + if (j_count-i_count >= nb) exit + if (j_count > nrow) exit + if (v(j_count) /= iproc ) exit + end do + end if + + if (length_row == 1) then + ! now we should insert rows i_count..j_count-1 + nnr = j_count - i_count + + if (iam == root) then + + ll = 0 + do i= i_count, j_count-1 + call a_glob%csget(i,i,nz,& + & irow,icol,val,info,nzin=ll,append=.true.) + if (info /= psb_success_) then + if (nz >min(size(irow(ll+1:)),size(icol(ll+1:)),size(val(ll+1:)))) then + write(psb_err_unit,*) 'Allocation failure? This should not happen!' + end if + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + ll = ll + nz + end do + + if (iproc == iam) then + call psb_spins(ll,irow,icol,val,a,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_spins' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + call psb_geins(nnr,(/(i,i=i_count,j_count-1)/),b_glob(i_count:j_count-1),& + & b,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psb_ins' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + else + call psb_snd(ictxt,nnr,iproc) + call psb_snd(ictxt,ll,iproc) + call psb_snd(ictxt,irow(1:ll),iproc) + call psb_snd(ictxt,icol(1:ll),iproc) + call psb_snd(ictxt,val(1:ll),iproc) + call psb_snd(ictxt,b_glob(i_count:j_count-1),iproc) + call psb_rcv(ictxt,ll,iproc) + endif + else if (iam /= root) then + + if (iproc == iam) then + call psb_rcv(ictxt,nnr,root) + call psb_rcv(ictxt,ll,root) + if (ll > size(irow)) then + write(psb_err_unit,*) iam,'need to reallocate ',ll + deallocate(val,irow,icol) + allocate(val(ll),irow(ll),icol(ll),stat=info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='Allocate' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + endif + call psb_rcv(ictxt,irow(1:ll),root) + call psb_rcv(ictxt,icol(1:ll),root) + call psb_rcv(ictxt,val(1:ll),root) + call psb_rcv(ictxt,b_glob(i_count:i_count+nnr-1),root) + call psb_snd(ictxt,ll,root) + call psb_spins(ll,irow,icol,val,a,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psspins' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + call psb_geins(nnr,(/(i,i=i_count,i_count+nnr-1)/),& + & b_glob(i_count:i_count+nnr-1),b,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psdsins' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + endif + endif + + i_count = j_count + + else + + ! here processors are counted 1..np + do j_count = 1, length_row + k_count = iwork(j_count) + if (iam == root) then + + ll = 0 + do i= i_count, i_count + call a_glob%csget(i,i,nz,& + & irow,icol,val,info,nzin=ll,append=.true.) + if (info /= psb_success_) then + if (nz >min(size(irow(ll+1:)),size(icol(ll+1:)),size(val(ll+1:)))) then + write(psb_err_unit,*) 'Allocation failure? This should not happen!' + end if + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + ll = ll + nz + end do + + if (k_count == iam) then + + call psb_spins(ll,irow,icol,val,a,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psspins' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + call psb_geins(1,(/i_count/),b_glob(i_count:i_count),& + & b,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psdsins' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + else + call psb_snd(ictxt,ll,k_count) + call psb_snd(ictxt,irow(1:ll),k_count) + call psb_snd(ictxt,icol(1:ll),k_count) + call psb_snd(ictxt,val(1:ll),k_count) + call psb_snd(ictxt,b_glob(i_count),k_count) + call psb_rcv(ictxt,ll,k_count) + endif + else if (iam /= root) then + if (k_count == iam) then + call psb_rcv(ictxt,ll,root) + call psb_rcv(ictxt,irow(1:ll),root) + call psb_rcv(ictxt,icol(1:ll),root) + call psb_rcv(ictxt,val(1:ll),root) + call psb_rcv(ictxt,b_glob(i_count),root) + call psb_snd(ictxt,ll,root) + call psb_spins(ll,irow,icol,val,a,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psspins' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + call psb_geins(1,(/i_count/),b_glob(i_count:i_count),& + & b,desc_a,info) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='psdsins' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + endif + endif + end do + i_count = i_count + 1 + endif + end do + + call psb_barrier(ictxt) + t0 = psb_wtime() + call psb_cdasb(desc_a,info) + t1 = psb_wtime() + if(info /= psb_success_)then + info=psb_err_from_subroutine_ + ch_err='psb_cdasb' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + call psb_barrier(ictxt) + t2 = psb_wtime() + call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=fmt,mold=mold) + t3 = psb_wtime() + if(info /= psb_success_)then + info=psb_err_from_subroutine_ + ch_err='psb_spasb' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + + if (iam == root) then + write(psb_out_unit,*) 'descriptor assembly: ',t1-t0 + write(psb_out_unit,*) 'sparse matrix assembly: ',t3-t2 + end if + + call psb_geasb(b,desc_a,info) + if(info /= psb_success_)then + info=psb_err_from_subroutine_ + ch_err='psdsasb' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + deallocate(val,irow,icol,stat=info) + if(info /= psb_success_)then + info=psb_err_from_subroutine_ + ch_err='deallocate' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + deallocate(iwork) + if (iam == root) write (*, fmt = *) 'end matdist' + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + +end subroutine zmatdist diff --git a/util/psb_z_mmio_impl.f90 b/util/psb_z_mmio_impl.f90 new file mode 100644 index 000000000..fe58a324e --- /dev/null +++ b/util/psb_z_mmio_impl.f90 @@ -0,0 +1,392 @@ +!!$ +!!$ Parallel Sparse BLAS version 3.0 +!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine mm_zvet_read(b, info, iunit, filename) + use psb_base_mod + implicit none + complex(psb_dpk_), allocatable, intent(out) :: b(:,:) + integer, intent(out) :: info + integer, optional, intent(in) :: iunit + character(len=*), optional, intent(in) :: filename + integer :: nrow, ncol, i,root, np, me, ircode, j,infile + real(psb_dpk_) :: bre, bim + character :: mmheader*15, fmt*15, object*10, type*10, sym*15,& + & line*1024 + + info = psb_success_ + if (present(filename)) then + if (filename == '-') then + infile=5 + else + if (present(iunit)) then + infile=iunit + else + infile=99 + endif + open(infile,file=filename, status='OLD', err=901, action='READ') + endif + else + if (present(iunit)) then + infile=iunit + else + infile=5 + endif + endif + + read(infile,fmt=*, end=902) mmheader, object, fmt, type, sym + + if ( (object /= 'matrix').or.(fmt /= 'array')) then + write(psb_err_unit,*) 'read_rhs: input file type not yet supported' + info = -3 + return + end if + + do + read(infile,fmt='(a)') line + if (line(1:1) /= '%') exit + end do + + read(line,fmt=*)nrow,ncol + + if ((psb_tolower(type) == 'real').and.(psb_tolower(sym) == 'general')) then + allocate(b(nrow,ncol),stat = ircode) + if (ircode /= 0) goto 993 + do j=1, ncol + do i=1, nrow + read(infile,fmt=*,end=902) bre,bim + b(i,j) = cmplx(bre,bim,kind=psb_dpk_) + end do + end do + + end if ! read right hand sides + if (infile /= 5) close(infile) + + return + ! open failed +901 write(psb_err_unit,*) 'mm_vet_read: could not open file ',& + & infile,' for input' + info = -1 + return + +902 write(psb_err_unit,*) 'mmv_vet_read: unexpected end of file ',infile,& + & ' during input' + info = -2 + return +993 write(psb_err_unit,*) 'mm_vet_read: memory allocation failure' + info = -3 + return +end subroutine mm_zvet_read + +subroutine mm_zvet2_write(b, header, info, iunit, filename) + use psb_base_mod + implicit none + complex(psb_dpk_), intent(in) :: b(:,:) + character(len=*), intent(in) :: header + integer, intent(out) :: info + integer, optional, intent(in) :: iunit + character(len=*), optional, intent(in) :: filename + integer :: nrow, ncol, i,root, np, me, ircode, j, outfile + + character(len=80) :: frmtv + + info = psb_success_ + if (present(filename)) then + if (filename == '-') then + outfile=6 + else + if (present(iunit)) then + outfile=iunit + else + outfile=99 + endif + open(outfile,file=filename, err=901, action='WRITE') + endif + else + if (present(iunit)) then + outfile=iunit + else + outfile=6 + endif + endif + + write(outfile,'(a)') '%%MatrixMarket matrix array real general' + write(outfile,'(a)') '% '//trim(header) + write(outfile,'(a)') '% ' + nrow = size(b,1) + ncol = size(b,2) + write(outfile,*) nrow,ncol + + write(frmtv,'(a,i5.5,a)') '(',2*ncol,'(es26.18,1x))' + + do i=1,size(b,1) + write(outfile,frmtv) b(i,1:ncol) + end do + + if (outfile /= 6) close(outfile) + + return + ! open failed +901 write(psb_err_unit,*) 'mm_vet_write: could not open file ',& + & outfile,' for output' + info = -1 + return + +end subroutine mm_zvet2_write + +subroutine mm_zvet1_write(b, header, info, iunit, filename) + use psb_base_mod + implicit none + complex(psb_dpk_), intent(in) :: b(:) + character(len=*), intent(in) :: header + integer, intent(out) :: info + integer, optional, intent(in) :: iunit + character(len=*), optional, intent(in) :: filename + integer :: nrow, ncol, i,root, np, me, ircode, j, outfile + + character(len=80) :: frmtv + + info = psb_success_ + if (present(filename)) then + if (filename == '-') then + outfile=6 + else + if (present(iunit)) then + outfile=iunit + else + outfile=99 + endif + open(outfile,file=filename, err=901, action='WRITE') + endif + else + if (present(iunit)) then + outfile=iunit + else + outfile=6 + endif + endif + + write(outfile,'(a)') '%%MatrixMarket matrix array real general' + write(outfile,'(a)') '% '//trim(header) + write(outfile,'(a)') '% ' + nrow = size(b,1) + ncol = 1 + write(outfile,*) nrow,ncol + + write(frmtv,'(a,i5.5,a)') '(',2*ncol,'(es26.18,1x))' + + do i=1,size(b,1) + write(outfile,frmtv) b(i) + end do + + if (outfile /= 6) close(outfile) + + return + ! open failed +901 write(psb_err_unit,*) 'mm_vet_write: could not open file ',& + & outfile,' for output' + info = -1 + return + +end subroutine mm_zvet1_write + +subroutine zmm_mat_read(a, info, iunit, filename) + use psb_base_mod + implicit none + type(psb_zspmat_type), intent(out) :: a + integer, intent(out) :: info + integer, optional, intent(in) :: iunit + character(len=*), optional, intent(in) :: filename + character :: mmheader*15, fmt*15, object*10, type*10, sym*15 + character(1024) :: line + integer :: nrow, ncol, nnzero + integer :: ircode, i,nzr,infile + type(psb_z_coo_sparse_mat), allocatable :: acoo + real(psb_dpk_) :: are, aim + info = psb_success_ + + if (present(filename)) then + if (filename == '-') then + infile=5 + else + if (present(iunit)) then + infile=iunit + else + infile=99 + endif + open(infile,file=filename, status='OLD', err=901, action='READ') + endif + else + if (present(iunit)) then + infile=iunit + else + infile=5 + endif + endif + + read(infile,fmt=*,end=902) mmheader, object, fmt, type, sym + + if ( (psb_tolower(object) /= 'matrix').or.(psb_tolower(fmt) /= 'coordinate')) then + write(psb_err_unit,*) 'READ_MATRIX: input file type not yet supported' + info=909 + return + end if + + do + read(infile,fmt='(a)') line + if (line(1:1) /= '%') exit + end do + read(line,fmt=*) nrow,ncol,nnzero + + allocate(acoo, stat=ircode) + if (ircode /= 0) goto 993 + if ((psb_tolower(type) == 'complex').and.(psb_tolower(sym) == 'general')) then + call acoo%allocate(nrow,ncol,nnzero) + do i=1,nnzero + read(infile,fmt=*,end=902) acoo%ia(i),acoo%ja(i),are,aim + acoo%val(i) = cmplx(are,aim,kind=psb_dpk_) + end do + call acoo%set_nzeros(nnzero) + call acoo%fix(info) + + call a%mv_from(acoo) + call a%cscnv(ircode,type='csr') + + else if ((psb_tolower(type) == 'complex').and.(psb_tolower(sym) == 'symmetric')) then + ! we are generally working with non-symmetric matrices, so + ! we de-symmetrize what we are about to read + call acoo%allocate(nrow,ncol,2*nnzero) + do i=1,nnzero + read(infile,fmt=*,end=902) acoo%ia(i),acoo%ja(i),are,aim + acoo%val(i) = cmplx(are,aim,kind=psb_dpk_) + end do + nzr = nnzero + do i=1,nnzero + if (acoo%ia(i) /= acoo%ja(i)) then + nzr = nzr + 1 + acoo%val(nzr) = acoo%val(i) + acoo%ia(nzr) = acoo%ja(i) + acoo%ja(nzr) = acoo%ia(i) + end if + end do + call acoo%set_nzeros(nzr) + call acoo%fix(info) + + call a%mv_from(acoo) + call a%cscnv(ircode,type='csr') + + else if ((psb_tolower(type) == 'complex').and.(psb_tolower(sym) == 'hermitian')) then + ! we are generally working with non-symmetric matrices, so + ! we de-symmetrize what we are about to read + call acoo%allocate(nrow,ncol,2*nnzero) + do i=1,nnzero + read(infile,fmt=*,end=902) acoo%ia(i),acoo%ja(i),are,aim + acoo%val(i) = cmplx(are,aim,kind=psb_dpk_) + end do + nzr = nnzero + do i=1,nnzero + if (acoo%ia(i) /= acoo%ja(i)) then + nzr = nzr + 1 + acoo%val(nzr) = conjg(acoo%val(i)) + acoo%ia(nzr) = acoo%ja(i) + acoo%ja(nzr) = acoo%ia(i) + end if + end do + call acoo%set_nzeros(nzr) + call acoo%fix(info) + + call a%mv_from(acoo) + call a%cscnv(ircode,type='csr') + + else + write(psb_err_unit,*) 'read_matrix: matrix type not yet supported' + info=904 + end if + if (infile /= 5) close(infile) + return + + ! open failed +901 info=901 + write(psb_err_unit,*) 'read_matrix: could not open file ',filename,' for input' + return +902 info=902 + write(psb_err_unit,*) 'READ_MATRIX: Unexpected end of file ' + return +993 info=993 + write(psb_err_unit,*) 'READ_MATRIX: Memory allocation failure' + return +end subroutine zmm_mat_read + +subroutine zmm_mat_write(a,mtitle,info,iunit,filename) + use psb_base_mod + implicit none + type(psb_zspmat_type), intent(in) :: a + integer, intent(out) :: info + character(len=*), intent(in) :: mtitle + integer, optional, intent(in) :: iunit + character(len=*), optional, intent(in) :: filename + integer :: iout + + + info = psb_success_ + + if (present(filename)) then + if (filename == '-') then + iout=6 + else + if (present(iunit)) then + iout = iunit + else + iout=99 + endif + open(iout,file=filename, err=901, action='WRITE') + endif + else + if (present(iunit)) then + iout = iunit + else + iout=6 + endif + endif + + call a%print(iout,head=mtitle) + + if (iout /= 6) close(iout) + + + return + +901 continue + info=901 + write(psb_err_unit,*) 'Error while opening ',filename + return +end subroutine zmm_mat_write + + diff --git a/util/psb_renum_impl.F90 b/util/psb_z_renum_impl.F90 similarity index 76% rename from util/psb_renum_impl.F90 rename to util/psb_z_renum_impl.F90 index f335d5c22..1a5e84e4b 100644 --- a/util/psb_renum_impl.F90 +++ b/util/psb_z_renum_impl.F90 @@ -1,10 +1,11 @@ -subroutine psb_d_mat_renum(alg,mat,info) +subroutine psb_z_mat_renum(alg,mat,info,perm) use psb_base_mod - use psb_renum_mod, psb_protect_name => psb_d_mat_renum + use psb_renum_mod, psb_protect_name => psb_z_mat_renum implicit none integer, intent(in) :: alg - type(psb_dspmat_type), intent(inout) :: mat + type(psb_zspmat_type), intent(inout) :: mat integer, intent(out) :: info + integer, allocatable, optional, intent(out) :: perm(:) integer :: err_act character(len=20) :: name @@ -18,7 +19,7 @@ subroutine psb_d_mat_renum(alg,mat,info) select case (alg) case(psb_mat_renum_gps_) - call psb_mat_renum_gps(mat,info) + call psb_mat_renum_gps(mat,info,perm) case default info = psb_err_input_value_invalid_i_ @@ -45,17 +46,18 @@ subroutine psb_d_mat_renum(alg,mat,info) contains - subroutine psb_mat_renum_gps(a,info) + subroutine psb_mat_renum_gps(a,info,operm) use psb_base_mod use psb_gps_mod implicit none - type(psb_dspmat_type), intent(inout) :: a + type(psb_zspmat_type), intent(inout) :: a integer, intent(out) :: info + integer, allocatable, optional, intent(out) :: operm(:) ! - class(psb_d_base_sparse_mat), allocatable :: aa - type(psb_d_csr_sparse_mat) :: acsr - type(psb_d_coo_sparse_mat) :: acoo + class(psb_z_base_sparse_mat), allocatable :: aa + type(psb_z_csr_sparse_mat) :: acsr + type(psb_z_coo_sparse_mat) :: acoo integer :: err_act character(len=20) :: name @@ -112,9 +114,17 @@ contains ! Get back to where we started from call aa%mv_from_coo(acoo,info) - call a%mv_from(aa) - + if (present(operm)) then + call psb_realloc(nr,operm,info) + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + end if + operm(1:nr) = perm(1:nr) + end if + deallocate(aa) call psb_erractionrestore(err_act) return @@ -128,4 +138,4 @@ contains return end subroutine psb_mat_renum_gps -end subroutine psb_d_mat_renum +end subroutine psb_z_mat_renum