fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-20 12:52:14 +00:00
Code Issues Packages Projects Releases Wiki Activity

psblas3:

Browse Source 
Reworked error constant names and typographical fixes.
This commit is contained in:
Salvatore Filippone
2010-04-22 15:35:14 +00:00
parent 22876a972f
commit 6b278318bd
346 changed files with 9843 additions and 9777 deletions
Download Patch File Download Diff File Expand all files Collapse all files
test/serial/d_coo_matgen.f03
+20 -20
View File
@@ -35,7 +35,7 @@ program d_coo_matgen
integer :: info, err_act
character(len=20) :: name,ch_err
info=0
info=psb_success_
call psb_init(ictxt)
@@ -63,7 +63,7 @@ program d_coo_matgen
call create_matrix(idim,a,b,x,desc_a,ictxt,afmt,info)
call psb_barrier(ictxt)
t2 = psb_wtime() - t1
if(info /= 0) then
if(info /= psb_success_) then
call psb_error(ictxt)
end if
@@ -166,7 +166,7 @@ contains
character(len=20) :: name, ch_err, asbfmt
info = 0
info = psb_success_
name = 'create_matrix'
call psb_erractionsave(err_act)
@@ -204,8 +204,8 @@ contains
!!$ write(*,*) 'Test get size:',d_coo_get_size(acoo)
!!$ write(*,*) 'Test 2 get size:',acoo%get_size(),acoo%get_nzeros()
if (info /= 0) then
info=4010
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='allocation rout.'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
@@ -217,8 +217,8 @@ contains
!
allocate(val(20*nb),irow(20*nb),&
&icol(20*nb),myidx(nlr),stat=info)
if (info /= 0 ) then
info=4000
if (info /= psb_success_ ) then
info=psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
endif
@@ -259,7 +259,7 @@ contains
!
! term depending on (x-1,y,z)
!
if (x==1) then
if (x == 1) then
val(element)=-b1(glob_x,glob_y,glob_z)&
& -a1(glob_x,glob_y,glob_z)
val(element) = val(element)/(deltah*&
@@ -275,7 +275,7 @@ contains
element = element+1
endif
! term depending on (x,y-1,z)
if (y==1) then
if (y == 1) then
val(element)=-b2(glob_x,glob_y,glob_z)&
& -a2(glob_x,glob_y,glob_z)
val(element) = val(element)/(deltah*&
@@ -291,7 +291,7 @@ contains
element = element+1
endif
! term depending on (x,y,z-1)
if (z==1) then
if (z == 1) then
val(element)=-b3(glob_x,glob_y,glob_z)&
& -a3(glob_x,glob_y,glob_z)
val(element) = val(element)/(deltah*&
@@ -319,7 +319,7 @@ contains
irow(element) = glob_row
element = element+1
! term depending on (x,y,z+1)
if (z==idim) then
if (z == idim) then
val(element)=-b1(glob_x,glob_y,glob_z)
val(element) = val(element)/(deltah*&
& deltah)
@@ -333,7 +333,7 @@ contains
element = element+1
endif
! term depending on (x,y+1,z)
if (y==idim) then
if (y == idim) then
val(element)=-b2(glob_x,glob_y,glob_z)
val(element) = val(element)/(deltah*&
& deltah)
@@ -362,8 +362,8 @@ contains
end do
tgen = psb_wtime()-t1
if(info /= 0) then
info=4010
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='insert rout.'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
@@ -375,8 +375,8 @@ contains
call acoo%fix(info)
!!$ write(0,*) '2 out of loop ',acoo%get_nzeros()
if(info /= 0) then
info=4010
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='asb rout.'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
@@ -385,8 +385,8 @@ contains
!!$ call acoo%print(20)
t1 = psb_wtime()
call acsr%cp_from_coo(acoo,info)
if(info /= 0) then
info=4010
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='cp rout.'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
@@ -395,8 +395,8 @@ contains
!!$ call acsr%print(21)
t1 = psb_wtime()
call acsr%mv_from_coo(acoo,info)
if(info /= 0) then
info=4010
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='mv rout.'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
test/serial/d_matgen.f03
+20 -20
View File
@@ -36,7 +36,7 @@ program d_matgen
integer :: info, err_act
character(len=20) :: name,ch_err
info=0
info=psb_success_
call psb_init(ictxt)
@@ -64,7 +64,7 @@ program d_matgen
call create_matrix(idim,a,b,x,desc_a,ictxt,afmt,info)
call psb_barrier(ictxt)
t2 = psb_wtime() - t1
if(info /= 0) then
if(info /= psb_success_) then
call psb_error(ictxt)
end if
@@ -170,7 +170,7 @@ contains
character(len=20) :: name, ch_err
info = 0
info = psb_success_
name = 'create_matrix'
!!$ call psb_erractionsave(err_act)
@@ -205,8 +205,8 @@ contains
talc = psb_wtime()-t0
if (info /= 0) then
info=4010
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='allocation rout.'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
@@ -218,8 +218,8 @@ contains
!
allocate(val(20*nb),irow(20*nb),&
&icol(20*nb),myidx(nlr),stat=info)
if (info /= 0 ) then
info=4000
if (info /= psb_success_ ) then
info=psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
endif
@@ -259,7 +259,7 @@ contains
!
! term depending on (x-1,y,z)
!
if (x==1) then
if (x == 1) then
val(element)=-b1(glob_x,glob_y,glob_z)&
& -a1(glob_x,glob_y,glob_z)
val(element) = val(element)/(deltah*&
@@ -275,7 +275,7 @@ contains
element = element+1
endif
! term depending on (x,y-1,z)
if (y==1) then
if (y == 1) then
val(element)=-b2(glob_x,glob_y,glob_z)&
& -a2(glob_x,glob_y,glob_z)
val(element) = val(element)/(deltah*&
@@ -291,7 +291,7 @@ contains
element = element+1
endif
! term depending on (x,y,z-1)
if (z==1) then
if (z == 1) then
val(element)=-b3(glob_x,glob_y,glob_z)&
& -a3(glob_x,glob_y,glob_z)
val(element) = val(element)/(deltah*&
@@ -319,7 +319,7 @@ contains
irow(element) = glob_row
element = element+1
! term depending on (x,y,z+1)
if (z==idim) then
if (z == idim) then
val(element)=-b1(glob_x,glob_y,glob_z)
val(element) = val(element)/(deltah*&
& deltah)
@@ -333,7 +333,7 @@ contains
element = element+1
endif
! term depending on (x,y+1,z)
if (y==idim) then
if (y == idim) then
val(element)=-b2(glob_x,glob_y,glob_z)
val(element) = val(element)/(deltah*&
& deltah)
@@ -362,8 +362,8 @@ contains
end do
tgen = psb_wtime()-t1
if(info /= 0) then
info=4010
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='insert rout.'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
@@ -372,8 +372,8 @@ contains
t1 = psb_wtime()
call a_n%cscnv(info,mold=acsr)
if(info /= 0) then
info=4010
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='asb rout.'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
@@ -384,7 +384,7 @@ contains
write(0,*) 'Nrm infinity ',anorm
call a_n%csget(2,3,element,irow,icol,val,info)
write(0,*) 'From csget ',element,info
if (info == 0) then
if (info == psb_success_) then
do i=1,element
write(0,*) irow(i),icol(i),val(i)
end do
@@ -399,15 +399,15 @@ contains
allocate(diag(nlr),stat=info)
if (info == 0) then
if (info == psb_success_) then
call a_n%get_diag(diag,info)
end if
!!$
t1 = psb_wtime()
call a_n%cscnv(info,mold=acxx)
if(info /= 0) then
info=4010
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='asb rout.'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
test/serial/psb_d_cxx_impl.f03
+54 -54
View File
@@ -1,5 +1,5 @@
!=====================================
! == ===================================
!
!
!
@@ -10,7 +10,7 @@
!
!
!
!=====================================
! == ===================================
subroutine d_cxx_csmv_impl(alpha,a,x,beta,y,info,trans)
use psb_error_mod
@@ -32,7 +32,7 @@ subroutine d_cxx_csmv_impl(alpha,a,x,beta,y,info,trans)
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = 0
info = psb_success_
if (present(trans)) then
trans_ = trans
@@ -47,7 +47,7 @@ subroutine d_cxx_csmv_impl(alpha,a,x,beta,y,info,trans)
endif
tra = (psb_toupper(trans_)=='T').or.(psb_toupper(trans_)=='C')
tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C')
if (tra) then
m = a%get_ncols()
@@ -316,7 +316,7 @@ subroutine d_cxx_csmm_impl(alpha,a,x,beta,y,info,trans)
character(len=20) :: name='d_cxx_csmm'
logical, parameter :: debug=.false.
info = 0
info = psb_success_
call psb_erractionsave(err_act)
if (present(trans)) then
@@ -330,7 +330,7 @@ subroutine d_cxx_csmm_impl(alpha,a,x,beta,y,info,trans)
call psb_errpush(info,name)
goto 9999
endif
tra = (psb_toupper(trans_)=='T').or.(psb_toupper(trans_)=='C')
tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C')
if (tra) then
m = a%get_ncols()
@@ -343,8 +343,8 @@ subroutine d_cxx_csmm_impl(alpha,a,x,beta,y,info,trans)
nc = min(size(x,2) , size(y,2) )
allocate(acc(nc), stat=info)
if(info /= 0) then
info=4010
if(info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='allocate')
goto 9999
end if
@@ -607,7 +607,7 @@ subroutine d_cxx_cssv_impl(alpha,a,x,beta,y,info,trans)
character(len=20) :: name='d_cxx_cssv'
logical, parameter :: debug=.false.
info = 0
info = psb_success_
call psb_erractionsave(err_act)
if (present(trans)) then
trans_ = trans
@@ -620,7 +620,7 @@ subroutine d_cxx_cssv_impl(alpha,a,x,beta,y,info,trans)
goto 9999
endif
tra = (psb_toupper(trans_)=='T').or.(psb_toupper(trans_)=='C')
tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C')
m = a%get_nrows()
if (.not. (a%is_triangle())) then
@@ -671,7 +671,7 @@ subroutine d_cxx_cssv_impl(alpha,a,x,beta,y,info,trans)
end if
else
allocate(tmp(m), stat=info)
if (info /= 0) then
if (info /= psb_success_) then
return
end if
@@ -823,7 +823,7 @@ subroutine d_cxx_cssm_impl(alpha,a,x,beta,y,info,trans)
character(len=20) :: name='d_cxx_cssm'
logical, parameter :: debug=.false.
info = 0
info = psb_success_
call psb_erractionsave(err_act)
if (present(trans)) then
@@ -838,7 +838,7 @@ subroutine d_cxx_cssm_impl(alpha,a,x,beta,y,info,trans)
endif
tra = (psb_toupper(trans_)=='T').or.(psb_toupper(trans_)=='C')
tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C')
m = a%get_nrows()
nc = min(size(x,2) , size(y,2))
@@ -871,8 +871,8 @@ subroutine d_cxx_cssm_impl(alpha,a,x,beta,y,info,trans)
end do
else
allocate(tmp(m,nc), stat=info)
if(info /= 0) then
info=4010
if(info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='allocate')
goto 9999
end if
@@ -884,8 +884,8 @@ subroutine d_cxx_cssm_impl(alpha,a,x,beta,y,info,trans)
end do
end if
if(info /= 0) then
info=4010
if(info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='inner_cxxsm')
goto 9999
end if
@@ -917,10 +917,10 @@ contains
integer :: i,j,k,m, ir, jc
real(psb_dpk_), allocatable :: acc(:)
info = 0
info = psb_success_
allocate(acc(nc), stat=info)
if(info /= 0) then
info=4010
if(info /= psb_success_) then
info=psb_err_from_subroutine_
return
end if
@@ -1046,7 +1046,7 @@ function d_cxx_csnmi_impl(a) result(res)
end function d_cxx_csnmi_impl
!=====================================
! == ===================================
!
!
!
@@ -1056,7 +1056,7 @@ end function d_cxx_csnmi_impl
!
!
!
!=====================================
! == ===================================
subroutine d_cxx_csgetptn_impl(imin,imax,a,nz,ia,ja,info,&
@@ -1085,7 +1085,7 @@ subroutine d_cxx_csgetptn_impl(imin,imax,a,nz,ia,ja,info,&
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = 0
info = psb_success_
if (present(jmin)) then
jmin_ = jmin
@@ -1124,7 +1124,7 @@ subroutine d_cxx_csgetptn_impl(imin,imax,a,nz,ia,ja,info,&
cscale_ = .false.
endif
if ((rscale_.or.cscale_).and.(present(iren))) then
info = 583
info = psb_err_many_optional_arg_
call psb_errpush(info,name,a_err='iren (rscale.or.cscale)')
goto 9999
end if
@@ -1142,7 +1142,7 @@ subroutine d_cxx_csgetptn_impl(imin,imax,a,nz,ia,ja,info,&
end do
end if
if (info /= 0) goto 9999
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
@@ -1186,7 +1186,7 @@ contains
irw = imin
lrw = min(imax,a%get_nrows())
if (irw<0) then
info = 2
info = psb_err_pivot_too_small_
return
end if
@@ -1201,9 +1201,9 @@ contains
call psb_ensure_size(nzin_+nzt,ia,info)
if (info==0) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info /= 0) return
if (info /= psb_success_) return
if (present(iren)) then
do i=irw, lrw
@@ -1261,7 +1261,7 @@ subroutine d_cxx_csgetrow_impl(imin,imax,a,nz,ia,ja,val,info,&
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = 0
info = psb_success_
if (present(jmin)) then
jmin_ = jmin
@@ -1300,7 +1300,7 @@ subroutine d_cxx_csgetrow_impl(imin,imax,a,nz,ia,ja,val,info,&
cscale_ = .false.
endif
if ((rscale_.or.cscale_).and.(present(iren))) then
info = 583
info = psb_err_many_optional_arg_
call psb_errpush(info,name,a_err='iren (rscale.or.cscale)')
goto 9999
end if
@@ -1319,7 +1319,7 @@ subroutine d_cxx_csgetrow_impl(imin,imax,a,nz,ia,ja,val,info,&
end do
end if
if (info /= 0) goto 9999
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
@@ -1364,7 +1364,7 @@ contains
irw = imin
lrw = min(imax,a%get_nrows())
if (irw<0) then
info = 2
info = psb_err_pivot_too_small_
return
end if
@@ -1379,10 +1379,10 @@ contains
call psb_ensure_size(nzin_+nzt,ia,info)
if (info==0) call psb_ensure_size(nzin_+nzt,ja,info)
if (info==0) call psb_ensure_size(nzin_+nzt,val,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
if (info /= 0) return
if (info /= psb_success_) return
if (present(iren)) then
do i=irw, lrw
@@ -1434,7 +1434,7 @@ subroutine d_cxx_csput_impl(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
logical, parameter :: debug=.false.
integer :: nza, i,j,k, nzl, isza, int_err(5)
info = 0
info = psb_success_
nza = a%get_nzeros()
if (a%is_bld()) then
@@ -1445,7 +1445,7 @@ subroutine d_cxx_csput_impl(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
call d_cxx_srch_upd(nz,ia,ja,val,a,&
& imin,imax,jmin,jmax,info,gtl)
if (info /= 0) then
if (info /= psb_success_) then
info = 1121
end if
@@ -1454,7 +1454,7 @@ subroutine d_cxx_csput_impl(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
! State is wrong.
info = 1121
end if
if (info /= 0) then
if (info /= psb_success_) then
call psb_errpush(info,name)
goto 9999
end if
@@ -1494,7 +1494,7 @@ contains
integer :: debug_level, debug_unit
character(len=20) :: name='d_cxx_srch_upd'
info = 0
info = psb_success_
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
@@ -1693,10 +1693,10 @@ subroutine d_cp_cxx_from_coo_impl(a,b,info)
integer :: debug_level, debug_unit
character(len=20) :: name
info = 0
info = psb_success_
! This is to have fix_coo called behind the scenes
call tmp%cp_from_coo(b,info)
if (info ==0) call a%mv_from_coo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
end subroutine d_cp_cxx_from_coo_impl
@@ -1720,7 +1720,7 @@ subroutine d_cp_cxx_to_coo_impl(a,b,info)
integer :: debug_level, debug_unit
character(len=20) :: name
info = 0
info = psb_success_
nr = a%get_nrows()
nc = a%get_ncols()
@@ -1762,7 +1762,7 @@ subroutine d_mv_cxx_to_coo_impl(a,b,info)
integer :: debug_level, debug_unit
character(len=20) :: name
info = 0
info = psb_success_
nr = a%get_nrows()
nc = a%get_ncols()
@@ -1773,7 +1773,7 @@ subroutine d_mv_cxx_to_coo_impl(a,b,info)
call move_alloc(a%ja,b%ja)
call move_alloc(a%val,b%val)
call psb_realloc(nza,b%ia,info)
if (info /= 0) return
if (info /= psb_success_) return
do i=1, nr
do j=a%irp(i),a%irp(i+1)-1
b%ia(j) = i
@@ -1806,10 +1806,10 @@ subroutine d_mv_cxx_from_coo_impl(a,b,info)
integer :: debug_level, debug_unit
character(len=20) :: name
info = 0
info = psb_success_
call b%fix(info)
if (info /= 0) return
if (info /= psb_success_) return
nr = b%get_nrows()
nc = b%get_ncols()
@@ -1896,7 +1896,7 @@ subroutine d_mv_cxx_to_fmt_impl(a,b,info)
integer :: debug_level, debug_unit
character(len=20) :: name
info = 0
info = psb_success_
select type (b)
type is (psb_d_coo_sparse_mat)
@@ -1911,7 +1911,7 @@ subroutine d_mv_cxx_to_fmt_impl(a,b,info)
class default
call tmp%mv_from_fmt(a,info)
if (info == 0) call b%mv_from_coo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
end select
end subroutine d_mv_cxx_to_fmt_impl
@@ -1936,7 +1936,7 @@ subroutine d_cp_cxx_to_fmt_impl(a,b,info)
integer :: debug_level, debug_unit
character(len=20) :: name
info = 0
info = psb_success_
select type (b)
@@ -1951,7 +1951,7 @@ subroutine d_cp_cxx_to_fmt_impl(a,b,info)
class default
call tmp%cp_from_fmt(a,info)
if (info == 0) call b%mv_from_coo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
end select
end subroutine d_cp_cxx_to_fmt_impl
@@ -1976,7 +1976,7 @@ subroutine d_mv_cxx_from_fmt_impl(a,b,info)
integer :: debug_level, debug_unit
character(len=20) :: name
info = 0
info = psb_success_
select type (b)
type is (psb_d_coo_sparse_mat)
@@ -1991,7 +1991,7 @@ subroutine d_mv_cxx_from_fmt_impl(a,b,info)
class default
call tmp%mv_from_fmt(b,info)
if (info == 0) call a%mv_from_coo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
end select
end subroutine d_mv_cxx_from_fmt_impl
@@ -2017,7 +2017,7 @@ subroutine d_cp_cxx_from_fmt_impl(a,b,info)
integer :: debug_level, debug_unit
character(len=20) :: name
info = 0
info = psb_success_
select type (b)
type is (psb_d_coo_sparse_mat)
@@ -2031,7 +2031,7 @@ subroutine d_cp_cxx_from_fmt_impl(a,b,info)
class default
call tmp%cp_from_fmt(b,info)
if (info == 0) call a%mv_from_coo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
end select
end subroutine d_cp_cxx_from_fmt_impl
test/serial/psb_d_cxx_mat_mod.f03
+67 -67
View File
@@ -252,7 +252,7 @@ module psb_d_cxx_mat_mod
contains
!=====================================
! == ===================================
!
!
!
@@ -262,7 +262,7 @@ contains
!
!
!
!=====================================
! == ===================================
function d_cxx_sizeof(a) result(res)
@@ -334,7 +334,7 @@ contains
!=====================================
! == ===================================
!
!
!
@@ -344,7 +344,7 @@ contains
!
!
!
!=====================================
! == ===================================
subroutine d_cxx_reallocate_nz(nz,a)
@@ -360,11 +360,11 @@ contains
call psb_erractionsave(err_act)
call psb_realloc(nz,a%ja,info)
if (info == 0) call psb_realloc(nz,a%val,info)
if (info == 0) call psb_realloc(&
if (info == psb_success_) call psb_realloc(nz,a%val,info)
if (info == psb_success_) call psb_realloc(&
& max(nz,a%get_nrows()+1,a%get_ncols()+1),a%irp,info)
if (info /= 0) then
call psb_errpush(4000,name)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
end if
@@ -399,29 +399,29 @@ contains
integer :: nza, i,j,k, nzl, isza, int_err(5)
call psb_erractionsave(err_act)
info = 0
info = psb_success_
if (nz <= 0) then
info = 10
info = psb_err_iarg_neg_
int_err(1)=1
call psb_errpush(info,name,i_err=int_err)
goto 9999
end if
if (size(ia) < nz) then
info = 35
info = psb_err_input_asize_invalid_i_
int_err(1)=2
call psb_errpush(info,name,i_err=int_err)
goto 9999
end if
if (size(ja) < nz) then
info = 35
info = psb_err_input_asize_invalid_i_
int_err(1)=3
call psb_errpush(info,name,i_err=int_err)
goto 9999
end if
if (size(val) < nz) then
info = 35
info = psb_err_input_asize_invalid_i_
int_err(1)=4
call psb_errpush(info,name,i_err=int_err)
goto 9999
@@ -430,7 +430,7 @@ contains
if (nz == 0) return
call d_cxx_csput_impl(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
if (info /= 0) goto 9999
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
@@ -466,12 +466,12 @@ contains
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = 0
info = psb_success_
call d_cxx_csgetptn_impl(imin,imax,a,nz,ia,ja,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
if (info /= 0) goto 9999
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
@@ -510,12 +510,12 @@ contains
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = 0
info = psb_success_
call d_cxx_csgetrow_impl(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
if (info /= 0) goto 9999
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
@@ -553,7 +553,7 @@ contains
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = 0
info = psb_success_
if (present(append)) then
append_ = append
@@ -570,11 +570,11 @@ contains
& jmin=jmin, jmax=jmax, iren=iren, append=append_, &
& nzin=nzin, rscale=rscale, cscale=cscale)
if (info /= 0) goto 9999
if (info /= psb_success_) goto 9999
call b%set_nzeros(nzin+nzout)
call b%fix(info)
if (info /= 0) goto 9999
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
@@ -610,7 +610,7 @@ contains
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = 0
info = psb_success_
nzin = 0
if (present(imin)) then
@@ -660,12 +660,12 @@ contains
& jmin=jmin_, jmax=jmax_, append=.false., &
& nzin=nzin, rscale=rscale_, cscale=cscale_)
if (info /= 0) goto 9999
if (info /= psb_success_) goto 9999
call b%set_nzeros(nzin+nzout)
call b%fix(info)
if (info /= 0) goto 9999
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
@@ -710,7 +710,7 @@ contains
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = 0
info = psb_success_
if (present(clear)) then
@@ -756,14 +756,14 @@ contains
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = 0
info = psb_success_
m = a%get_nrows()
nz = a%get_nzeros()
if (info == 0) call psb_realloc(m+1,a%irp,info)
if (info == 0) call psb_realloc(nz,a%ja,info)
if (info == 0) call psb_realloc(nz,a%val,info)
if (info == psb_success_) call psb_realloc(m+1,a%irp,info)
if (info == psb_success_) call psb_realloc(nz,a%ja,info)
if (info == psb_success_) call psb_realloc(nz,a%val,info)
if (info /= 0) goto 9999
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
@@ -792,9 +792,9 @@ contains
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = 0
info = psb_success_
call d_cp_cxx_to_coo_impl(a,b,info)
if (info /= 0) goto 9999
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
@@ -824,9 +824,9 @@ contains
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = 0
info = psb_success_
call d_cp_cxx_from_coo_impl(a,b,info)
if (info /= 0) goto 9999
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
@@ -857,9 +857,9 @@ contains
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = 0
info = psb_success_
call d_cp_cxx_to_fmt_impl(a,b,info)
if (info /= 0) goto 9999
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
@@ -889,9 +889,9 @@ contains
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = 0
info = psb_success_
call d_cp_cxx_from_fmt_impl(a,b,info)
if (info /= 0) goto 9999
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
@@ -922,9 +922,9 @@ contains
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = 0
info = psb_success_
call d_mv_cxx_to_coo_impl(a,b,info)
if (info /= 0) goto 9999
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
@@ -954,9 +954,9 @@ contains
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = 0
info = psb_success_
call d_mv_cxx_from_coo_impl(a,b,info)
if (info /= 0) goto 9999
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
@@ -987,9 +987,9 @@ contains
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = 0
info = psb_success_
call d_mv_cxx_to_fmt_impl(a,b,info)
if (info /= 0) goto 9999
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
@@ -1019,9 +1019,9 @@ contains
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = 0
info = psb_success_
call d_mv_cxx_from_fmt_impl(a,b,info)
if (info /= 0) goto 9999
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
@@ -1051,14 +1051,14 @@ contains
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = 0
info = psb_success_
if (m < 0) then
info = 10
info = psb_err_iarg_neg_
call psb_errpush(info,name,i_err=(/1,0,0,0,0/))
goto 9999
endif
if (n < 0) then
info = 10
info = psb_err_iarg_neg_
call psb_errpush(info,name,i_err=(/2,0,0,0,0/))
goto 9999
endif
@@ -1068,15 +1068,15 @@ contains
nz_ = max(7*m,7*n,1)
end if
if (nz_ < 0) then
info = 10
info = psb_err_iarg_neg_
call psb_errpush(info,name,i_err=(/3,0,0,0,0/))
goto 9999
endif
if (info == 0) call psb_realloc(m+1,a%irp,info)
if (info == 0) call psb_realloc(nz_,a%ja,info)
if (info == 0) call psb_realloc(nz_,a%val,info)
if (info == 0) then
if (info == psb_success_) call psb_realloc(m+1,a%irp,info)
if (info == psb_success_) call psb_realloc(nz_,a%ja,info)
if (info == psb_success_) call psb_realloc(nz_,a%val,info)
if (info == psb_success_) then
a%irp=0
call a%set_nrows(m)
call a%set_ncols(n)
@@ -1195,7 +1195,7 @@ contains
call psb_erractionsave(err_act)
info = 0
info = psb_success_
call a%allocate(b%get_nrows(),b%get_ncols(),b%get_nzeros())
call a%psb_d_base_sparse_mat%cp_from(b%psb_d_base_sparse_mat)
@@ -1203,7 +1203,7 @@ contains
a%ja = b%ja
a%val = b%val
if (info /= 0) goto 9999
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
@@ -1232,7 +1232,7 @@ contains
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = 0
info = psb_success_
call a%psb_d_base_sparse_mat%mv_from(b%psb_d_base_sparse_mat)
call move_alloc(b%irp, a%irp)
call move_alloc(b%ja, a%ja)
@@ -1256,7 +1256,7 @@ contains
!=====================================
! == ===================================
!
!
!
@@ -1267,7 +1267,7 @@ contains
!
!
!
!=====================================
! == ===================================
subroutine d_cxx_csmv(alpha,a,x,beta,y,info,trans)
@@ -1298,7 +1298,7 @@ contains
call d_cxx_csmm_impl(alpha,a,x,beta,y,info,trans)
if (info /= 0) goto 9999
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
@@ -1337,7 +1337,7 @@ contains
call d_cxx_csmm_impl(alpha,a,x,beta,y,info,trans)
if (info /= 0) goto 9999
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
@@ -1486,12 +1486,12 @@ contains
character(len=20) :: name='get_diag'
logical, parameter :: debug=.false.
info = 0
info = psb_success_
call psb_erractionsave(err_act)
mnm = min(a%get_nrows(),a%get_ncols())
if (size(d) < mnm) then
info=35
info=psb_err_input_asize_invalid_i_
call psb_errpush(info,name,i_err=(/2,size(d),0,0,0/))
goto 9999
end if
@@ -1500,7 +1500,7 @@ contains
do i=1, mnm
do k=a%irp(i),a%irp(i+1)-1
j=a%ja(k)
if ((j==i) .and.(j <= mnm )) then
if ((j == i) .and.(j <= mnm )) then
d(i) = a%val(k)
endif
enddo
@@ -1534,12 +1534,12 @@ contains
character(len=20) :: name='scal'
logical, parameter :: debug=.false.
info = 0
info = psb_success_
call psb_erractionsave(err_act)
m = a%get_nrows()
if (size(d) < m) then
info=35
info=psb_err_input_asize_invalid_i_
call psb_errpush(info,name,i_err=(/2,size(d),0,0,0/))
goto 9999
end if
@@ -1576,7 +1576,7 @@ contains
character(len=20) :: name='scal'
logical, parameter :: debug=.false.
info = 0
info = psb_success_
call psb_erractionsave(err_act)