fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Fixed error handling on ALLOCATE.

Browse Source
psblas3-type-indexed
Salvatore Filippone 18 years ago
parent 3801148fde
commit 88f0e7ef53
15 changed files with 174 additions and 157 deletions
Show Stats Download Patch File Download Diff File

4
base/modules/psb_error_mod.F90
Unescape Escape View File

@ -409,8 +409,6 @@ contains
write (0,'("BLACS error. Number of processes=-1")')
case(2011)
write (0,'("Initialization error: not enough processes available in the parallel environment")')
case(2025)
write (0,'("Cannot allocate ",i0," bytes")')i_e_d(1)
case(2030)
write (0,'("BLACS ERROR: Number of grid columns must be equal to 1\nCurrent value is ",i4," != 1.")')i_e_d(1)
case(2231)
@ -466,6 +464,8 @@ contains
write (0,'("Error ",i0," from call to a subroutine ")')i_e_d(1)
case(4013)
write (0,'("Error from call to subroutine ",a," ",i0)')a_e_d,i_e_d(1)
case(4025)
write (0,'("Error on allocation request for ",i0," items of type ")')i_e_d(1),a_e_d
case(4110)
write (0,'("Error ",i0," from call to an external package in subroutine ",a)')i_e_d(1),a_e_d
case (5001)

95
base/modules/psb_realloc_mod.F90
Unescape Escape View File

@ -622,8 +622,8 @@ Contains
lb_ = 1
endif
if ((len<0)) then
err=2025
call psb_errpush(err,name,i_err=(/len,0,0,0,0/))
err=4025
call psb_errpush(err,name,i_err=(/len,0,0,0,0/),a_err='integer')
goto 9999
end if
ub_ = lb_+len-1
@ -634,8 +634,8 @@ Contains
If ((dim /= len).or.(lbi /= lb_)) Then
Allocate(tmp(lb_:ub_),stat=info)
if (info /= 0) then
err=4000
call psb_errpush(err,name)
err=4025
call psb_errpush(err,name,i_err=(/len,0,0,0,0/),a_err='integer')
goto 9999
end if
tmp(lb_:lb_-1+min(len,dim))=rrax(lbi:lbi-1+min(len,dim))
@ -645,8 +645,8 @@ Contains
dim = 0
allocate(rrax(lb_:ub_),stat=info)
if (info /= 0) then
err=4000
call psb_errpush(err,name)
err=4025
call psb_errpush(err,name,i_err=(/len,0,0,0,0/),a_err='integer')
goto 9999
end if
endif
@ -698,8 +698,8 @@ Contains
lb_ = 1
endif
if ((len<0)) then
err=2025
call psb_errpush(err,name,i_err=(/len,0,0,0,0/))
err=4025
call psb_errpush(err,name,i_err=(/len,0,0,0,0/),a_err='real(kind(1.d0))')
goto 9999
end if
ub_ = lb_ + len-1
@ -710,8 +710,8 @@ Contains
If ((dim /= len).or.(lbi /= lb_)) Then
Allocate(tmp(lb_:ub_),stat=info)
if (info /= 0) then
err=4000
call psb_errpush(err,name)
err=4025
call psb_errpush(err,name,i_err=(/len,0,0,0,0/),a_err='real(kind(1.d0))')
goto 9999
end if
tmp(lb_:lb_-1+min(len,dim))=rrax(lbi:lbi-1+min(len,dim))
@ -721,8 +721,8 @@ Contains
dim = 0
Allocate(rrax(lb_:ub_),stat=info)
if (info /= 0) then
err=4000
call psb_errpush(err,name)
err=4025
call psb_errpush(err,name,i_err=(/len,0,0,0,0/),a_err='real(kind(1.d0))')
goto 9999
end if
endif
@ -771,8 +771,8 @@ Contains
lb_ = 1
endif
if ((len<0)) then
err=2025
call psb_errpush(err,name,i_err=(/len,0,0,0,0/))
err=4025
call psb_errpush(err,name,i_err=(/len,0,0,0,0/),a_err='complex(kind(1.d0))')
goto 9999
end if
ub_ = lb_+len-1
@ -783,8 +783,8 @@ Contains
If ((dim /= len).or.(lbi /= lb_)) Then
Allocate(tmp(lb_:ub_),stat=info)
if (info /= 0) then
err=4000
call psb_errpush(err,name)
err=4025
call psb_errpush(err,name,i_err=(/len,0,0,0,0/),a_err='complex(kind(1.d0))')
goto 9999
end if
tmp(lb_:lb_-1+min(len,dim))=rrax(lbi:lbi-1+min(len,dim))
@ -794,8 +794,8 @@ Contains
dim = 0
Allocate(rrax(lb_:ub_),stat=info)
if (info /= 0) then
err=4000
call psb_errpush(err,name)
err=4025
call psb_errpush(err,name,i_err=(/len,0,0,0,0/),a_err='complex(kind(1.d0))')
goto 9999
end if
endif
@ -851,6 +851,18 @@ Contains
ub1_ = lb1_ + len1 -1
ub2_ = lb2_ + len2 -1
if (len1 < 0) then
err=4025
call psb_errpush(err,name,i_err=(/len1,0,0,0,0/),a_err='real(kind(1.d0))')
goto 9999
end if
if (len2 < 0) then
err=4025
call psb_errpush(err,name,i_err=(/len2,0,0,0,0/),a_err='real(kind(1.d0))')
goto 9999
end if
if (allocated(rrax)) then
dim = size(rrax,1)
lbi1 = lbound(rrax,1)
@ -860,8 +872,8 @@ Contains
& .or.(lbi2 /= lb2_)) Then
Allocate(tmp(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= 0) then
err=4000
call psb_errpush(err,name)
err=4025
call psb_errpush(err,name,i_err=(/len1*len2,0,0,0,0/),a_err='real(kind(1.d0))')
goto 9999
end if
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
@ -873,8 +885,8 @@ Contains
dim2 = 0
Allocate(rrax(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= 0) then
err=4000
call psb_errpush(err,name)
err=4025
call psb_errpush(err,name,i_err=(/len1*len2,0,0,0,0/),a_err='real(kind(1.d0))')
goto 9999
end if
endif
@ -931,6 +943,18 @@ Contains
ub1_ = lb1_ + len1 -1
ub2_ = lb2_ + len2 -1
if (len1 < 0) then
err=4025
call psb_errpush(err,name,i_err=(/len1,0,0,0,0/),a_err='complex(kind(1.d0))')
goto 9999
end if
if (len2 < 0) then
err=4025
call psb_errpush(err,name,i_err=(/len2,0,0,0,0/),a_err='complex(kind(1.d0))')
goto 9999
end if
if (allocated(rrax)) then
dim = size(rrax,1)
lbi1 = lbound(rrax,1)
@ -940,8 +964,8 @@ Contains
& .or.(lbi2 /= lb2_)) Then
Allocate(tmp(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= 0) then
err=4000
call psb_errpush(err,name)
err=4025
call psb_errpush(err,name,i_err=(/len1*len2,0,0,0,0/),a_err='complex(kind(1.d0))')
goto 9999
end if
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
@ -953,8 +977,8 @@ Contains
dim2 = 0
Allocate(rrax(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= 0) then
err=4000
call psb_errpush(err,name)
err=4025
call psb_errpush(err,name,i_err=(/len1*len2,0,0,0,0/),a_err='complex(kind(1.d0))')
goto 9999
end if
endif
@ -1010,6 +1034,17 @@ Contains
ub1_ = lb1_ + len1 -1
ub2_ = lb2_ + len2 -1
if (len1 < 0) then
err=4025
call psb_errpush(err,name,i_err=(/len1,0,0,0,0/),a_err='integer')
goto 9999
end if
if (len2 < 0) then
err=4025
call psb_errpush(err,name,i_err=(/len2,0,0,0,0/),a_err='integer')
goto 9999
end if
if (allocated(rrax)) then
dim = size(rrax,1)
lbi1 = lbound(rrax,1)
@ -1019,8 +1054,8 @@ Contains
& .or.(lbi2 /= lb2_)) Then
Allocate(tmp(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= 0) then
err=4000
call psb_errpush(err,name)
err=4025
call psb_errpush(err,name,i_err=(/len1*len2,0,0,0,0/),a_err='integer')
goto 9999
end if
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
@ -1032,8 +1067,8 @@ Contains
dim2 = 0
Allocate(rrax(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= 0) then
err=4000
call psb_errpush(err,name)
err=4025
call psb_errpush(err,name,i_err=(/len1*len2,0,0,0,0/),a_err='integer')
goto 9999
end if
endif

33
base/tools/psb_cd_inloc.f90
Unescape Escape View File

@ -171,9 +171,9 @@ subroutine psb_cd_inloc(v, ictxt, desc_a, info)
desc_a%matrix_data(psb_desc_size_) = psb_desc_normal_
end if
if (info /= 0) then
info=2025
int_err(1)=m
call psb_errpush(info,name,i_err=int_err)
info=4025
int_err(1)=2*m+psb_mdata_size_
call psb_errpush(info,name,i_err=int_err,a_err='integer')
goto 9999
endif
@ -224,9 +224,9 @@ subroutine psb_cd_inloc(v, ictxt, desc_a, info)
& desc_a%ptree(2),stat=info)
if (info == 0) call InitPairSearchTree(desc_a%ptree,info)
if (info /= 0) then
info=2025
info=4025
int_err(1)=loc_col
call psb_errpush(info,name,i_err=int_err)
call psb_errpush(info,name,i_err=int_err,a_err='integer')
goto 9999
end if
@ -289,9 +289,9 @@ subroutine psb_cd_inloc(v, ictxt, desc_a, info)
allocate(desc_a%loc_to_glob(loc_col),&
&desc_a%lprm(1),stat=info)
if (info /= 0) then
info=2025
info=4025
int_err(1)=loc_col
call psb_errpush(info,name,i_err=int_err)
call psb_errpush(info,name,i_err=int_err,a_err='integer')
goto 9999
end if
@ -326,9 +326,9 @@ subroutine psb_cd_inloc(v, ictxt, desc_a, info)
if (debug) write(*,*) 'PSB_CDALL: Ov len',l_ov_ix,l_ov_el
allocate(ov_idx(l_ov_ix),ov_el(l_ov_el), stat=info)
if (info /= 0) then
info=2025
int_err(1)=l_ov_ix
call psb_errpush(info,name,i_err=int_err)
info=4025
int_err(1)=l_ov_ix+l_ov_el
call psb_errpush(info,name,i_err=int_err,a_err='integer')
goto 9999
end if
@ -372,18 +372,13 @@ subroutine psb_cd_inloc(v, ictxt, desc_a, info)
call psb_cd_set_bld(desc_a,info)
call psb_realloc(1,desc_a%halo_index, info)
if (info /= psb_no_err_) then
info=2025
call psb_errpush(err,name,a_err='psb_realloc')
if (info == 0) call psb_realloc(1,desc_a%ext_index, info)
if (info /= 0) then
info=4010
call psb_errpush(info,name,a_err='psb_realloc')
Goto 9999
end if
desc_a%halo_index(:) = -1
call psb_realloc(1,desc_a%ext_index, info)
if (info /= psb_no_err_) then
info=2025
call psb_errpush(err,name,a_err='psb_realloc')
Goto 9999
end if
desc_a%ext_index(:) = -1
call psb_erractionrestore(err_act)

24
base/tools/psb_cdals.f90
Unescape Escape View File

@ -128,10 +128,10 @@ subroutine psb_cdals(m, n, parts, ictxt, desc_a, info)
desc_a%matrix_data(psb_desc_size_) = psb_desc_normal_
end if
if (info /= 0) then
info=2025
info=4025
err=info
int_err(1)=m
call psb_errpush(err,name,int_err)
int_err(1)=2*m+psb_mdata_size_+np
call psb_errpush(err,name,int_err,a_err='integer')
goto 9999
endif
desc_a%matrix_data(psb_m_) = m
@ -151,9 +151,9 @@ subroutine psb_cdals(m, n, parts, ictxt, desc_a, info)
& desc_a%ptree(2),stat=info)
if (info == 0) call InitPairSearchTree(desc_a%ptree,info)
if (info /= 0) then
info=2025
info=4025
int_err(1)=loc_col
call psb_errpush(info,name,i_err=int_err)
call psb_errpush(info,name,i_err=int_err,a_err='integer')
goto 9999
end if
@ -398,19 +398,13 @@ subroutine psb_cdals(m, n, parts, ictxt, desc_a, info)
call psb_cd_set_bld(desc_a,info)
call psb_realloc(1,desc_a%halo_index, info)
if (info /= psb_no_err_) then
info=2025
call psb_errpush(err,name,a_err='psb_realloc')
if (info == 0) call psb_realloc(1,desc_a%ext_index, info)
if (info /= 0) then
info=4010
call psb_errpush(info,name,a_err='psb_realloc')
Goto 9999
end if
desc_a%halo_index(:) = -1
call psb_realloc(1,desc_a%ext_index, info)
if (info /= psb_no_err_) then
info=2025
call psb_errpush(err,name,a_err='psb_realloc')
Goto 9999
end if
desc_a%ext_index(:) = -1

22
base/tools/psb_cdalv.f90
Unescape Escape View File

@ -141,9 +141,9 @@ subroutine psb_cdalv(v, ictxt, desc_a, info, flag)
desc_a%matrix_data(psb_desc_size_) = psb_desc_normal_
end if
if (info /= 0) then
info=2025
int_err(1)=m
call psb_errpush(info,name,i_err=int_err)
info=4025
int_err(1)=2*m+psb_mdata_size_
call psb_errpush(info,name,i_err=int_err,a_err='integer')
goto 9999
endif
@ -194,9 +194,9 @@ subroutine psb_cdalv(v, ictxt, desc_a, info, flag)
& desc_a%ptree(2),stat=info)
if (info == 0) call InitPairSearchTree(desc_a%ptree,info)
if (info /= 0) then
info=2025
info=4025
int_err(1)=loc_col
call psb_errpush(info,name,i_err=int_err)
call psb_errpush(info,name,i_err=int_err,a_err='integer')
goto 9999
end if
@ -259,9 +259,9 @@ subroutine psb_cdalv(v, ictxt, desc_a, info, flag)
allocate(desc_a%loc_to_glob(loc_col),&
&desc_a%lprm(1),stat=info)
if (info /= 0) then
info=2025
info=4025
int_err(1)=loc_col
call psb_errpush(info,name,i_err=int_err)
call psb_errpush(info,name,i_err=int_err,a_err='integer')
goto 9999
end if
@ -296,9 +296,9 @@ subroutine psb_cdalv(v, ictxt, desc_a, info, flag)
if (debug) write(*,*) 'PSB_CDALL: Ov len',l_ov_ix,l_ov_el
allocate(ov_idx(l_ov_ix),ov_el(l_ov_el), stat=info)
if (info /= 0) then
info=2025
info=4025
int_err(1)=l_ov_ix
call psb_errpush(info,name,i_err=int_err)
call psb_errpush(info,name,i_err=int_err,a_err='integer')
goto 9999
end if
@ -343,7 +343,7 @@ subroutine psb_cdalv(v, ictxt, desc_a, info, flag)
call psb_realloc(1,desc_a%halo_index, info)
if (info /= psb_no_err_) then
info=2025
info=4010
call psb_errpush(err,name,a_err='psb_realloc')
Goto 9999
end if
@ -351,7 +351,7 @@ subroutine psb_cdalv(v, ictxt, desc_a, info, flag)
call psb_realloc(1,desc_a%ext_index, info)
if (info /= psb_no_err_) then
info=2025
info=4010
call psb_errpush(err,name,a_err='psb_realloc')
Goto 9999
end if

8
base/tools/psb_cdrep.f90
Unescape Escape View File

@ -176,12 +176,10 @@ subroutine psb_cdrep(m, ictxt, desc_a, info)
! allocate work vector
allocate(desc_a%glob_to_loc(m),desc_a%matrix_data(psb_mdata_size_),&
& desc_a%loc_to_glob(m),desc_a%lprm(1),stat=info)
!!$ & desc_a%ovrlap_index(1),desc_a%ovrlap_elem(1),&
!!$ & desc_a%halo_index(1),desc_a%bnd_elem(1),stat=info)
if (info /= 0) then
info=2025
int_err(1)=m
call psb_errpush(info,name,i_err=int_err)
info=4025
int_err(1)=2*m+psb_mdata_size_+1
call psb_errpush(info,name,i_err=int_err,a_err='integer')
goto 9999
endif
! If the index space is replicated there's no point in having

34
base/tools/psb_dallc.f90
Unescape Escape View File

@ -108,9 +108,9 @@ subroutine psb_dalloc(x, desc_a, info, n)
n_col = max(1,psb_cd_get_local_cols(desc_a))
allocate(x(n_col,n_),stat=info)
if (info /= 0) then
info=4010
ch_err='allocate'
call psb_errpush(info,name,a_err=ch_err)
info=4025
int_err(1)=n_col*n_
call psb_errpush(info,name,int_err,a_err='real(kind(1.d0))')
goto 9999
endif
do j=1,n_
@ -122,9 +122,9 @@ subroutine psb_dalloc(x, desc_a, info, n)
n_row = max(1,psb_cd_get_local_rows(desc_a))
allocate(x(n_row,n_),stat=info)
if (info /= 0) then
info=4010
ch_err='allocate'
call psb_errpush(info,name,a_err=ch_err)
info=4025
int_err(1)=n_row*n_
call psb_errpush(info,name,int_err,a_err='real(kind(1.d0))')
goto 9999
endif
do j = 1, n_
@ -203,7 +203,7 @@ subroutine psb_dallocv(x, desc_a,info,n)
!locals
integer :: np,me,n_col,n_row,i,err_act
integer :: ictxt
integer :: ictxt, n_, int_err(5)
logical, parameter :: debug=.false.
character(len=20) :: name, ch_err
@ -234,11 +234,11 @@ subroutine psb_dallocv(x, desc_a,info,n)
!....allocate x .....
if (psb_is_asb_desc(desc_a).or.psb_is_upd_desc(desc_a)) then
n_col = max(1,psb_cd_get_local_cols(desc_a))
call psb_realloc(n_col,x,info)
if (info /= 0) then
info=4010
ch_err='psb_realloc'
call psb_errpush(info,name,a_err=ch_err)
allocate(x(n_col),stat=info)
if (info.ne.0) then
info=4025
int_err(1)=n_col
call psb_errpush(info,name,int_err,a_err='real(kind(1.d0))')
goto 9999
endif
do i=1,n_col
@ -247,11 +247,11 @@ subroutine psb_dallocv(x, desc_a,info,n)
else if (psb_is_bld_desc(desc_a)) then
n_row = max(1,psb_cd_get_local_rows(desc_a))
call psb_realloc(n_row,x,info)
if (info /= 0) then
info=4010
ch_err='psb_realloc'
call psb_errpush(info,name,a_err=ch_err)
allocate(x(n_row),stat=info)
if (info.ne.0) then
info=4025
int_err(1)=n_row
call psb_errpush(info,name,int_err,a_err='real(kind(1.d0))')
goto 9999
endif
do i=1,n_row

10
base/tools/psb_dasb.f90
Unescape Escape View File

@ -100,9 +100,8 @@ subroutine psb_dasb(x, desc_a, info)
if (i1sz < ncol) then
call psb_realloc(ncol,i2sz,x,info)
if (info /= 0) then
info=2025
int_err(1)=ncol
call psb_errpush(info,name,i_err=int_err)
info=4010
call psb_errpush(info,name,a_err='psb_realloc')
goto 9999
endif
endif
@ -215,9 +214,8 @@ subroutine psb_dasbv(x, desc_a, info)
if (i1sz < ncol) then
call psb_realloc(ncol,x,info)
if (info /= 0) then
info=2025
int_err(1)=ncol
call psb_errpush(info,name,i_err=int_err)
info=4010
call psb_errpush(info,name,a_err='psb_realloc')
goto 9999
endif
endif

4
base/tools/psb_dspcnv.f90
Unescape Escape View File

@ -159,9 +159,9 @@ subroutine psb_dspcnv(a,b,desc_a,info)
call psb_sp_all(b,ia1_size,ia2_size,aspk_size,info)
allocate(work_dcsdp(l_dcsdp),stat=info)
if (info /= 0) then
info=2025
info=4025
int_err(1)=l_dcsdp
call psb_errpush(info, name, i_err=int_err)
call psb_errpush(info, name, i_err=int_err,a_err='real(kind(1.d0))')
goto 9999
endif

22
base/tools/psb_ialloc.f90
Unescape Escape View File

@ -105,9 +105,9 @@ subroutine psb_ialloc(x, desc_a, info, n)
n_col = max(1,psb_cd_get_local_cols(desc_a))
allocate(x(n_col,n_),stat=info)
if (info /= 0) then
info=4010
ch_err='allocate'
call psb_errpush(info,name,a_err=ch_err)
info=4025
int_err(1)=n_col*n_
call psb_errpush(info,name,int_err,a_err='integer')
goto 9999
endif
do j=1,n_
@ -119,9 +119,9 @@ subroutine psb_ialloc(x, desc_a, info, n)
n_row = max(1,psb_cd_get_local_rows(desc_a))
allocate(x(n_row,n_),stat=info)
if (info /= 0) then
info=4010
ch_err='allocate'
call psb_errpush(info,name,a_err=ch_err)
info=4025
int_err(1)=n_row*n_
call psb_errpush(info,name,int_err,a_err='integer')
goto 9999
endif
do j = 1, n_
@ -205,7 +205,7 @@ subroutine psb_iallocv(x, desc_a, info,n)
integer :: ictxt, n_
integer :: int_err(5)
logical, parameter :: debug=.false.
character(len=20) :: name
character(len=20) :: name, ch_err
if(psb_get_errstatus() /= 0) return
info=0
@ -236,18 +236,18 @@ subroutine psb_iallocv(x, desc_a, info,n)
n_col = max(1,psb_cd_get_local_cols(desc_a))
allocate(x(n_col),stat=info)
if (info.ne.0) then
info=2025
info=4025
int_err(1)=n_col
call psb_errpush(info,name,int_err)
call psb_errpush(info,name,int_err,a_err='integer')
goto 9999
endif
else if (psb_is_bld_desc(desc_a)) then
n_row = max(1,psb_cd_get_local_rows(desc_a))
allocate(x(n_row),stat=info)
if (info.ne.0) then
info=2025
info=4025
int_err(1)=n_row
call psb_errpush(info,name,int_err)
call psb_errpush(info,name,int_err,a_err='integer')
goto 9999
endif
endif

10
base/tools/psb_iasb.f90
Unescape Escape View File

@ -98,9 +98,9 @@ subroutine psb_iasb(x, desc_a, info)
if (i1sz.lt.ncol) then
call psb_realloc(ncol,i2sz,x,info)
if (info /= 0) then
info=2025
int_err(1)=ncol
call psb_errpush(info,name,int_err)
info=4025
int_err(1)=ncol*i2sz
call psb_errpush(info,name,int_err,a_err='integer')
goto 9999
endif
endif
@ -210,9 +210,9 @@ subroutine psb_iasbv(x, desc_a, info)
if (i1sz.lt.ncol) then
call psb_realloc(ncol,x,info)
if (info /= 0) then
info=2025
info=4025
int_err(1)=ncol
call psb_errpush(info,name,int_err)
call psb_errpush(info,name,int_err,a_err='integer')
goto 9999
endif
endif

34
base/tools/psb_zallc.f90
Unescape Escape View File

@ -107,9 +107,9 @@ subroutine psb_zalloc(x, desc_a, info, n)
n_col = max(1,psb_cd_get_local_cols(desc_a))
allocate(x(n_col,n_),stat=info)
if (info /= 0) then
info=4010
ch_err='allocate'
call psb_errpush(info,name,a_err=ch_err)
info=4025
int_err(1)=n_col*n_
call psb_errpush(info,name,int_err,a_err='complex(kind(1.d0))')
goto 9999
endif
do j=1,n_
@ -121,9 +121,9 @@ subroutine psb_zalloc(x, desc_a, info, n)
n_row = max(1,psb_cd_get_local_rows(desc_a))
allocate(x(n_row,n_),stat=info)
if (info /= 0) then
info=4010
ch_err='allocate'
call psb_errpush(info,name,a_err=ch_err)
info=4025
int_err(1)=n_row*n_
call psb_errpush(info,name,int_err,a_err='complex(kind(1.d0))')
goto 9999
endif
do j = 1, n_
@ -202,7 +202,7 @@ subroutine psb_zallocv(x, desc_a,info,n)
!locals
integer :: np,me,n_col,n_row,i,err_act
integer :: ictxt, n_
integer :: ictxt, n_, int_err(5)
logical, parameter :: debug=.false.
character(len=20) :: name, ch_err
@ -234,11 +234,11 @@ subroutine psb_zallocv(x, desc_a,info,n)
!....allocate x .....
if (psb_is_asb_desc(desc_a).or.psb_is_upd_desc(desc_a)) then
n_col = max(1,psb_cd_get_local_cols(desc_a))
call psb_realloc(n_col,x,info)
if (info /= 0) then
info=4010
ch_err='psb_realloc'
call psb_errpush(info,name,a_err=ch_err)
allocate(x(n_col),stat=info)
if (info.ne.0) then
info=4025
int_err(1)=n_col
call psb_errpush(info,name,int_err,a_err='complex(kind(1.d0))')
goto 9999
endif
do i=1,n_col
@ -247,11 +247,11 @@ subroutine psb_zallocv(x, desc_a,info,n)
else if (psb_is_bld_desc(desc_a)) then
n_row = max(1,psb_cd_get_local_rows(desc_a))
call psb_realloc(n_row,x,info)
if (info /= 0) then
info=4010
ch_err='psb_realloc'
call psb_errpush(info,name,a_err=ch_err)
allocate(x(n_row),stat=info)
if (info.ne.0) then
info=4025
int_err(1)=n_row
call psb_errpush(info,name,int_err,a_err='complex(kind(1.d0))')
goto 9999
endif
do i=1,n_row

10
base/tools/psb_zasb.f90
Unescape Escape View File

@ -97,9 +97,8 @@ subroutine psb_zasb(x, desc_a, info)
if (i1sz.lt.ncol) then
call psb_realloc(ncol,i2sz,x,info)
if (info /= 0) then
info=2025
int_err(1)=ncol
call psb_errpush(info,name,i_err=int_err)
info=4010
call psb_errpush(info,name,a_err='psb_realloc')
goto 9999
endif
endif
@ -212,9 +211,8 @@ subroutine psb_zasbv(x, desc_a, info)
if (i1sz.lt.ncol) then
call psb_realloc(ncol,x,info)
if (info /= 0) then
info=2025
int_err(1)=ncol
call psb_errpush(info,name,i_err=int_err)
info=4010
call psb_errpush(info,name,a_err='psb_realloc')
goto 9999
endif

4
base/tools/psb_zspcnv.f90
Unescape Escape View File

@ -160,9 +160,9 @@ subroutine psb_zspcnv(a,b,desc_a,info)
call psb_sp_all(b,ia1_size,ia2_size,aspk_size,info)
allocate(work_dcsdp(l_dcsdp),stat=info)
if (info /= 0) then
info=2025
info=4025
int_err(1)=l_dcsdp
call psb_errpush(info, name, i_err=int_err)
call psb_errpush(info, name, i_err=int_err,a_err='real(kind(1.d0))')
goto 9999
endif

17
util/psb_mat_dist_mod.f90
Unescape Escape View File

@ -171,9 +171,9 @@ contains
liwork = max(np, nrow + ncol)
allocate(iwork(liwork), stat = info)
if (info /= 0) then
info=2025
info=4025
int_err(1)=liwork
call psb_errpush(info,name,i_err=int_err)
call psb_errpush(info,name,i_err=int_err,a_err='integer')
goto 9999
endif
if (iam == root) then
@ -583,10 +583,9 @@ contains
liwork = max(np, nrow + ncol)
allocate(iwork(liwork), stat = info)
if (info /= 0) then
write(0,*) 'matdist allocation failed'
info=2025
info=4025
int_err(1)=liwork
call psb_errpush(info,name,i_err=int_err)
call psb_errpush(info,name,i_err=int_err,a_err='integer')
goto 9999
endif
@ -917,9 +916,9 @@ contains
liwork = max(np, nrow + ncol)
allocate(iwork(liwork), stat = info)
if (info /= 0) then
info=2025
info=4025
int_err(1)=liwork
call psb_errpush(info,name,i_err=int_err)
call psb_errpush(info,name,i_err=int_err,a_err='integer')
goto 9999
endif
if (iam == root) then
@ -1330,9 +1329,9 @@ contains
allocate(iwork(liwork), stat = info)
if (info /= 0) then
write(0,*) 'matdist allocation failed'
info=2025
info=4025
int_err(1)=liwork
call psb_errpush(info,name,i_err=int_err)
call psb_errpush(info,name,i_err=int_err,a_err='integer')
goto 9999
endif

Write Preview
Loading…
Cancel
Save