Fix LPK in tools impl.

ILmat
Salvatore Filippone 8 years ago
parent 47912056cf
commit 48fd24a4d3

@ -52,9 +52,9 @@ subroutine psb_cspalloc(a, desc_a, info, nnz)
integer(psb_ipk_), optional, intent(in) :: nnz integer(psb_ipk_), optional, intent(in) :: nnz
!locals !locals
integer(psb_ipk_) :: ictxt, dectype integer(psb_ipk_) :: ictxt, np, me, err_act
integer(psb_ipk_) :: np,me,loc_row,loc_col,& integer(psb_ipk_) :: loc_row,loc_col, nnz_
& length_ia1,length_ia2, err_act,m,n integer(psb_lpk_) :: m, n
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name character(len=20) :: name
@ -89,17 +89,16 @@ subroutine psb_cspalloc(a, desc_a, info, nnz)
call psb_errpush(info,name,i_err=(/7_psb_ipk_,nnz/)) call psb_errpush(info,name,i_err=(/7_psb_ipk_,nnz/))
goto 9999 goto 9999
endif endif
length_ia1=nnz nnz_ = nnz
length_ia2=nnz
else else
length_ia1=max(1,5*loc_row) nnz_ = max(1,5*loc_row)
endif endif
if (debug_level >= psb_debug_ext_) & if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),':allocating size:',length_ia1 & write(debug_unit,*) me,' ',trim(name),':allocating size:',nnz_
call a%free() call a%free()
!....allocate aspk, ia1, ia2..... !....allocate aspk, ia1, ia2.....
call a%csall(loc_row,loc_col,info,nz=length_ia1) call a%csall(loc_row,loc_col,info,nz=nnz_)
if(info /= psb_success_) then if(info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='sp_all') call psb_errpush(info,name,a_err='sp_all')

@ -63,9 +63,8 @@ subroutine psb_cspasb(a,desc_a, info, afmt, upd, dupl, mold)
class(psb_c_base_sparse_mat), intent(in), optional :: mold class(psb_c_base_sparse_mat), intent(in), optional :: mold
!....Locals.... !....Locals....
integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: int_err(5)
integer(psb_ipk_) :: np,me,n_col, err_act integer(psb_ipk_) :: ictxt,np,me, err_act
integer(psb_ipk_) :: spstate integer(psb_ipk_) :: n_row,n_col
integer(psb_ipk_) :: ictxt,n_row
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name, ch_err

@ -75,8 +75,9 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,&
character(len=5), optional :: outfmt character(len=5), optional :: outfmt
integer(psb_ipk_), intent(in), optional :: data integer(psb_ipk_), intent(in), optional :: data
! ...local scalars.... ! ...local scalars....
integer(psb_ipk_) :: np,me,counter,proc,i, & integer(psb_ipk_) :: ictxt, np,me
& n_el_send,k,n_el_recv,ictxt, idx, r, tot_elem,& integer(psb_ipk_) :: counter,proc,i, &
& n_el_send,k,n_el_recv,idx, r, tot_elem,&
& n_elem, j, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& & n_elem, j, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,&
& irmin,icmin,irmax,icmax,data_,ngtz,totxch,nxs, nxr,& & irmin,icmin,irmax,icmax,data_,ngtz,totxch,nxs, nxr,&
& l1, err_act & l1, err_act

@ -52,9 +52,9 @@ subroutine psb_dspalloc(a, desc_a, info, nnz)
integer(psb_ipk_), optional, intent(in) :: nnz integer(psb_ipk_), optional, intent(in) :: nnz
!locals !locals
integer(psb_ipk_) :: ictxt, dectype integer(psb_ipk_) :: ictxt, np, me, err_act
integer(psb_ipk_) :: np,me,loc_row,loc_col,& integer(psb_ipk_) :: loc_row,loc_col, nnz_
& length_ia1,length_ia2, err_act,m,n integer(psb_lpk_) :: m, n
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name character(len=20) :: name
@ -89,17 +89,16 @@ subroutine psb_dspalloc(a, desc_a, info, nnz)
call psb_errpush(info,name,i_err=(/7_psb_ipk_,nnz/)) call psb_errpush(info,name,i_err=(/7_psb_ipk_,nnz/))
goto 9999 goto 9999
endif endif
length_ia1=nnz nnz_ = nnz
length_ia2=nnz
else else
length_ia1=max(1,5*loc_row) nnz_ = max(1,5*loc_row)
endif endif
if (debug_level >= psb_debug_ext_) & if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),':allocating size:',length_ia1 & write(debug_unit,*) me,' ',trim(name),':allocating size:',nnz_
call a%free() call a%free()
!....allocate aspk, ia1, ia2..... !....allocate aspk, ia1, ia2.....
call a%csall(loc_row,loc_col,info,nz=length_ia1) call a%csall(loc_row,loc_col,info,nz=nnz_)
if(info /= psb_success_) then if(info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='sp_all') call psb_errpush(info,name,a_err='sp_all')

@ -63,9 +63,8 @@ subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl, mold)
class(psb_d_base_sparse_mat), intent(in), optional :: mold class(psb_d_base_sparse_mat), intent(in), optional :: mold
!....Locals.... !....Locals....
integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: int_err(5)
integer(psb_ipk_) :: np,me,n_col, err_act integer(psb_ipk_) :: ictxt,np,me, err_act
integer(psb_ipk_) :: spstate integer(psb_ipk_) :: n_row,n_col
integer(psb_ipk_) :: ictxt,n_row
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name, ch_err

@ -75,8 +75,9 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
character(len=5), optional :: outfmt character(len=5), optional :: outfmt
integer(psb_ipk_), intent(in), optional :: data integer(psb_ipk_), intent(in), optional :: data
! ...local scalars.... ! ...local scalars....
integer(psb_ipk_) :: np,me,counter,proc,i, & integer(psb_ipk_) :: ictxt, np,me
& n_el_send,k,n_el_recv,ictxt, idx, r, tot_elem,& integer(psb_ipk_) :: counter,proc,i, &
& n_el_send,k,n_el_recv,idx, r, tot_elem,&
& n_elem, j, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& & n_elem, j, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,&
& irmin,icmin,irmax,icmax,data_,ngtz,totxch,nxs, nxr,& & irmin,icmin,irmax,icmax,data_,ngtz,totxch,nxs, nxr,&
& l1, err_act & l1, err_act

@ -52,9 +52,9 @@ subroutine psb_sspalloc(a, desc_a, info, nnz)
integer(psb_ipk_), optional, intent(in) :: nnz integer(psb_ipk_), optional, intent(in) :: nnz
!locals !locals
integer(psb_ipk_) :: ictxt, dectype integer(psb_ipk_) :: ictxt, np, me, err_act
integer(psb_ipk_) :: np,me,loc_row,loc_col,& integer(psb_ipk_) :: loc_row,loc_col, nnz_
& length_ia1,length_ia2, err_act,m,n integer(psb_lpk_) :: m, n
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name character(len=20) :: name
@ -89,17 +89,16 @@ subroutine psb_sspalloc(a, desc_a, info, nnz)
call psb_errpush(info,name,i_err=(/7_psb_ipk_,nnz/)) call psb_errpush(info,name,i_err=(/7_psb_ipk_,nnz/))
goto 9999 goto 9999
endif endif
length_ia1=nnz nnz_ = nnz
length_ia2=nnz
else else
length_ia1=max(1,5*loc_row) nnz_ = max(1,5*loc_row)
endif endif
if (debug_level >= psb_debug_ext_) & if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),':allocating size:',length_ia1 & write(debug_unit,*) me,' ',trim(name),':allocating size:',nnz_
call a%free() call a%free()
!....allocate aspk, ia1, ia2..... !....allocate aspk, ia1, ia2.....
call a%csall(loc_row,loc_col,info,nz=length_ia1) call a%csall(loc_row,loc_col,info,nz=nnz_)
if(info /= psb_success_) then if(info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='sp_all') call psb_errpush(info,name,a_err='sp_all')

@ -63,9 +63,8 @@ subroutine psb_sspasb(a,desc_a, info, afmt, upd, dupl, mold)
class(psb_s_base_sparse_mat), intent(in), optional :: mold class(psb_s_base_sparse_mat), intent(in), optional :: mold
!....Locals.... !....Locals....
integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: int_err(5)
integer(psb_ipk_) :: np,me,n_col, err_act integer(psb_ipk_) :: ictxt,np,me, err_act
integer(psb_ipk_) :: spstate integer(psb_ipk_) :: n_row,n_col
integer(psb_ipk_) :: ictxt,n_row
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name, ch_err

@ -75,8 +75,9 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
character(len=5), optional :: outfmt character(len=5), optional :: outfmt
integer(psb_ipk_), intent(in), optional :: data integer(psb_ipk_), intent(in), optional :: data
! ...local scalars.... ! ...local scalars....
integer(psb_ipk_) :: np,me,counter,proc,i, & integer(psb_ipk_) :: ictxt, np,me
& n_el_send,k,n_el_recv,ictxt, idx, r, tot_elem,& integer(psb_ipk_) :: counter,proc,i, &
& n_el_send,k,n_el_recv,idx, r, tot_elem,&
& n_elem, j, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& & n_elem, j, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,&
& irmin,icmin,irmax,icmax,data_,ngtz,totxch,nxs, nxr,& & irmin,icmin,irmax,icmax,data_,ngtz,totxch,nxs, nxr,&
& l1, err_act & l1, err_act

@ -52,9 +52,9 @@ subroutine psb_zspalloc(a, desc_a, info, nnz)
integer(psb_ipk_), optional, intent(in) :: nnz integer(psb_ipk_), optional, intent(in) :: nnz
!locals !locals
integer(psb_ipk_) :: ictxt, dectype integer(psb_ipk_) :: ictxt, np, me, err_act
integer(psb_ipk_) :: np,me,loc_row,loc_col,& integer(psb_ipk_) :: loc_row,loc_col, nnz_
& length_ia1,length_ia2, err_act,m,n integer(psb_lpk_) :: m, n
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name character(len=20) :: name
@ -89,17 +89,16 @@ subroutine psb_zspalloc(a, desc_a, info, nnz)
call psb_errpush(info,name,i_err=(/7_psb_ipk_,nnz/)) call psb_errpush(info,name,i_err=(/7_psb_ipk_,nnz/))
goto 9999 goto 9999
endif endif
length_ia1=nnz nnz_ = nnz
length_ia2=nnz
else else
length_ia1=max(1,5*loc_row) nnz_ = max(1,5*loc_row)
endif endif
if (debug_level >= psb_debug_ext_) & if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),':allocating size:',length_ia1 & write(debug_unit,*) me,' ',trim(name),':allocating size:',nnz_
call a%free() call a%free()
!....allocate aspk, ia1, ia2..... !....allocate aspk, ia1, ia2.....
call a%csall(loc_row,loc_col,info,nz=length_ia1) call a%csall(loc_row,loc_col,info,nz=nnz_)
if(info /= psb_success_) then if(info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='sp_all') call psb_errpush(info,name,a_err='sp_all')

@ -63,9 +63,8 @@ subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl, mold)
class(psb_z_base_sparse_mat), intent(in), optional :: mold class(psb_z_base_sparse_mat), intent(in), optional :: mold
!....Locals.... !....Locals....
integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: int_err(5)
integer(psb_ipk_) :: np,me,n_col, err_act integer(psb_ipk_) :: ictxt,np,me, err_act
integer(psb_ipk_) :: spstate integer(psb_ipk_) :: n_row,n_col
integer(psb_ipk_) :: ictxt,n_row
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name, ch_err

@ -75,8 +75,9 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
character(len=5), optional :: outfmt character(len=5), optional :: outfmt
integer(psb_ipk_), intent(in), optional :: data integer(psb_ipk_), intent(in), optional :: data
! ...local scalars.... ! ...local scalars....
integer(psb_ipk_) :: np,me,counter,proc,i, & integer(psb_ipk_) :: ictxt, np,me
& n_el_send,k,n_el_recv,ictxt, idx, r, tot_elem,& integer(psb_ipk_) :: counter,proc,i, &
& n_el_send,k,n_el_recv,idx, r, tot_elem,&
& n_elem, j, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,& & n_elem, j, ipx,mat_recv, iszs, iszr,idxs,idxr,nz,&
& irmin,icmin,irmax,icmax,data_,ngtz,totxch,nxs, nxr,& & irmin,icmin,irmax,icmax,data_,ngtz,totxch,nxs, nxr,&
& l1, err_act & l1, err_act

Loading…
Cancel
Save