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

psblas3:

Browse Source 
base/tools/psb_callc.f90
 base/tools/psb_casb.f90
 base/tools/psb_ccdbldext.F90
 base/tools/psb_cfree.f90
 base/tools/psb_cins.f90
 base/tools/psb_cspalloc.f90
 base/tools/psb_cspasb.f90
 base/tools/psb_cspfree.f90
 base/tools/psb_csphalo.F90
 base/tools/psb_cspins.f90
 base/tools/psb_d_map.f90
 base/tools/psb_dallc.f90
 base/tools/psb_dasb.f90
 base/tools/psb_dcdbldext.F90
 base/tools/psb_dfree.f90
 base/tools/psb_dins.f90
 base/tools/psb_dspalloc.f90
 base/tools/psb_dspasb.f90
 base/tools/psb_dspfree.f90
 base/tools/psb_dsphalo.F90
 base/tools/psb_dspins.f90
 base/tools/psb_sallc.f90
 base/tools/psb_sasb.f90
 base/tools/psb_scdbldext.F90
 base/tools/psb_sfree.f90
 base/tools/psb_sins.f90
 base/tools/psb_sspalloc.f90
 base/tools/psb_sspasb.f90
 base/tools/psb_sspfree.f90
 base/tools/psb_ssphalo.F90
 base/tools/psb_sspins.f90
 base/tools/psb_zallc.f90
 base/tools/psb_zasb.f90
 base/tools/psb_zcdbldext.F90
 base/tools/psb_zfree.f90
 base/tools/psb_zins.f90
 base/tools/psb_zspalloc.f90
 base/tools/psb_zspasb.f90
 base/tools/psb_zspfree.f90
 base/tools/psb_zsphalo.F90
 base/tools/psb_zspins.f90


New error handling
psblas3-accel
Salvatore Filippone 10 years ago
parent 0d49855313
commit e48b9cfcea
41 changed files with 384 additions and 843 deletions
Show Stats Download Patch File Download Diff File

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

@ -125,12 +125,8 @@ subroutine psb_calloc(x, desc_a, info, n, lb)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_calloc
@ -242,16 +238,13 @@ subroutine psb_callocv(x, desc_a,info,n)
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
9999 call psb_error_handler(ictxt,err_act)
return
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
@ -319,12 +312,8 @@ subroutine psb_calloc_vect(x, desc_a,info,n)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_calloc_vect
@ -426,12 +415,8 @@ subroutine psb_calloc_vect_r2(x, desc_a,info,n,lb)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_calloc_vect_r2

37
base/tools/psb_casb.f90
Unescape Escape View File

@ -83,8 +83,7 @@ subroutine psb_casb(x, desc_a, info)
goto 9999
else if (.not.psb_is_asb_desc(desc_a)) then
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),' error ',&
& desc_a%get_dectype()
& write(debug_unit,*) me,' ',trim(name),' error '
info = psb_err_input_matrix_unassembled_
call psb_errpush(info,name)
goto 9999
@ -122,12 +121,8 @@ subroutine psb_casb(x, desc_a, info)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_casb
@ -240,16 +235,13 @@ subroutine psb_casbv(x, desc_a, info)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_casbv
subroutine psb_casb_vect(x, desc_a, info, mold, scratch)
use psb_base_mod, psb_protect_name => psb_casb_vect
implicit none
@ -319,12 +311,8 @@ subroutine psb_casb_vect(x, desc_a, info, mold, scratch)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_casb_vect
@ -385,7 +373,6 @@ subroutine psb_casb_vect_r2(x, desc_a, info, mold, scratch)
end do
else
do i=1, n
call x(i)%asb(ncol,info)
if (info /= 0) exit
@ -408,12 +395,8 @@ subroutine psb_casb_vect_r2(x, desc_a, info, mold, scratch)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_casb_vect_r2

8
base/tools/psb_ccdbldext.F90
Unescape Escape View File

@ -716,13 +716,9 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
9999 call psb_error_handler(ictxt,err_act)
return
end if
Return
End Subroutine psb_ccdbldext

32
base/tools/psb_cfree.f90
Unescape Escape View File

@ -90,12 +90,8 @@ subroutine psb_cfree(x, desc_a, info)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_cfree
@ -159,14 +155,8 @@ subroutine psb_cfreev(x, desc_a, info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_ret_) then
return
else
call psb_error(ictxt)
end if
return
end subroutine psb_cfreev
@ -219,12 +209,8 @@ subroutine psb_cfree_vect(x, desc_a, info)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_cfree_vect
@ -274,12 +260,8 @@ subroutine psb_cfree_vect_r2(x, desc_a, info)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_cfree_vect_r2

40
base/tools/psb_cins.f90
Unescape Escape View File

@ -171,14 +171,8 @@ subroutine psb_cinsvi(m, irw, val, x, desc_a, info, dupl,local)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_ret_) then
return
else
call psb_error(ictxt)
end if
return
end subroutine psb_cinsvi
@ -292,14 +286,8 @@ subroutine psb_cins_vect(m, irw, val, x, desc_a, info, dupl,local)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_ret_) then
return
else
call psb_error(ictxt)
end if
return
end subroutine psb_cins_vect
@ -408,14 +396,8 @@ subroutine psb_cins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_ret_) then
return
else
call psb_error(ictxt)
end if
return
end subroutine psb_cins_vect_v
@ -533,14 +515,8 @@ subroutine psb_cins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_ret_) then
return
else
call psb_error(ictxt)
end if
return
end subroutine psb_cins_vect_r2
@ -730,14 +706,8 @@ subroutine psb_cinsi(m, irw, val, x, desc_a, info, dupl,local)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_ret_) then
return
else
call psb_error(ictxt)
end if
return
end subroutine psb_cinsi

11
base/tools/psb_cspalloc.f90
Unescape Escape View File

@ -100,9 +100,8 @@ subroutine psb_cspalloc(a, desc_a, info, nnz)
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),':allocating size:',length_ia1
!....allocate aspk, ia1, ia2.....
call a%free()
!....allocate aspk, ia1, ia2.....
call a%csall(loc_row,loc_col,info,nz=length_ia1)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
@ -120,14 +119,8 @@ subroutine psb_cspalloc(a, desc_a, info, nnz)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_ret_) then
return
else
call psb_error(ictxt)
end if
return
end subroutine psb_cspalloc

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

@ -140,12 +140,8 @@ subroutine psb_cspasb(a,desc_a, info, afmt, upd, dupl, mold)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_cspasb

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

@ -70,12 +70,8 @@ subroutine psb_cspfree(a, desc_a,info)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_cspfree

8
base/tools/psb_csphalo.F90
Unescape Escape View File

@ -366,12 +366,8 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,&
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
9999 call psb_error_handler(ictxt,err_act)
return
End Subroutine psb_csphalo

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

@ -193,12 +193,8 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild,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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_cspins
@ -313,12 +309,8 @@ subroutine psb_cspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_cspins_2desc
@ -472,12 +464,8 @@ subroutine psb_cspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_cspins_v

2
base/tools/psb_d_map.f90
Unescape Escape View File

@ -142,7 +142,6 @@ subroutine psb_d_map_X2Y_vect(alpha,x,beta,y,map,info,work)
nr2 = map%p_desc_Y%get_global_rows()
nc2 = map%p_desc_Y%get_local_cols()
call yt%bld(nc2,mold=x%v)
!!$ write(0,*)'From map_aggr_X2Y apply: ',map%p_desc_X%v_halo_index%get_fmt()
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. map%p_desc_Y%is_repl()) then
@ -308,7 +307,6 @@ subroutine psb_d_map_Y2X_vect(alpha,x,beta,y,map,info,work)
nr2 = map%p_desc_X%get_global_rows()
nc2 = map%p_desc_X%get_local_cols()
call yt%bld(nc2,mold=y%v)
!!$ write(0,*)'From map_aggr_Y2X apply: ',map%p_desc_Y%v_halo_index%get_fmt()
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. map%p_desc_X%is_repl()) then

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

@ -56,7 +56,7 @@ subroutine psb_dalloc(x, desc_a, info, n, lb)
!locals
integer(psb_ipk_) :: np,me,err,nr,i,j,err_act
integer(psb_ipk_) :: ictxt,n_
integer(psb_ipk_) :: int_err(5), exch(3)
integer(psb_ipk_) :: int_err(5),exch(3)
character(len=20) :: name
name='psb_geall'
@ -76,7 +76,7 @@ subroutine psb_dalloc(x, desc_a, info, n, lb)
endif
!... check m and n parameters....
if (.not.desc_a%is_ok()) then
if (.not.psb_is_ok_desc(desc_a)) then
info = psb_err_input_matrix_unassembled_
call psb_errpush(info,name)
goto 9999
@ -125,12 +125,8 @@ subroutine psb_dalloc(x, desc_a, info, n, lb)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_dalloc
@ -167,9 +163,8 @@ end subroutine psb_dalloc
!!$
!!$
!
!
! Function: psb_dallocv
! Allocates dense matrix for PSBLAS routines.
! Allocates dense matrix for PSBLAS routines
! The descriptor may be in either the build or assembled state.
!
! Arguments:
@ -243,16 +238,13 @@ subroutine psb_dallocv(x, desc_a,info,n)
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
9999 call psb_error_handler(ictxt,err_act)
return
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
@ -312,7 +304,7 @@ subroutine psb_dalloc_vect(x, desc_a,info,n)
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_)')
call psb_errpush(info,name,int_err,a_err='real(psb_spk_)')
goto 9999
endif
call x%zero()
@ -320,12 +312,8 @@ subroutine psb_dalloc_vect(x, desc_a,info,n)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_dalloc_vect
@ -420,19 +408,15 @@ subroutine psb_dalloc_vect_r2(x, desc_a,info,n,lb)
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_)')
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_dalloc_vect_r2

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

@ -32,14 +32,14 @@
! File: psb_dasb.f90
!
! Subroutine: psb_dasb
! Assembles a dense matrix for PSBLAS routines.
! Assembles a dense matrix for PSBLAS routines
! Since the allocation may have been called with the desciptor
! in the build state we make sure that X has a number of rows
! allowing for the halo indices, reallocating if necessary.
! We also call the halo routine for good measure.
!
! Arguments:
! x(:,:) - real,allocatable The matrix to be assembled.
! x(:,:) - real, allocatable The matrix to be assembled.
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. return code
subroutine psb_dasb(x, desc_a, info)
@ -83,8 +83,7 @@ subroutine psb_dasb(x, desc_a, info)
goto 9999
else if (.not.psb_is_asb_desc(desc_a)) then
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),' error ',&
& desc_a%get_dectype()
& write(debug_unit,*) me,' ',trim(name),' error '
info = psb_err_input_matrix_unassembled_
call psb_errpush(info,name)
goto 9999
@ -122,12 +121,8 @@ subroutine psb_dasb(x, desc_a, info)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_dasb
@ -172,7 +167,7 @@ end subroutine psb_dasb
! We also call the halo routine for good measure.
!
! Arguments:
! x(:) - real,allocatable The matrix to be assembled.
! x(:) - real, allocatable The matrix to be assembled.
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code
subroutine psb_dasbv(x, desc_a, info)
@ -240,16 +235,13 @@ subroutine psb_dasbv(x, desc_a, info)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_dasbv
subroutine psb_dasb_vect(x, desc_a, info, mold, scratch)
use psb_base_mod, psb_protect_name => psb_dasb_vect
implicit none
@ -312,18 +304,15 @@ subroutine psb_dasb_vect(x, desc_a, info, mold, scratch)
if (present(mold)) then
call x%cnv(mold)
end if
end if
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': end'
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_dasb_vect
@ -355,9 +344,9 @@ subroutine psb_dasb_vect_r2(x, desc_a, info, mold, scratch)
ictxt = desc_a%get_context()
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
scratch_ = .false.
if (present(scratch)) scratch_ = scratch
call psb_info(ictxt, me, np)
! ....verify blacs grid correctness..
@ -406,12 +395,8 @@ subroutine psb_dasb_vect_r2(x, desc_a, info, mold, scratch)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_dasb_vect_r2

8
base/tools/psb_dcdbldext.F90
Unescape Escape View File

@ -716,13 +716,9 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
9999 call psb_error_handler(ictxt,err_act)
return
end if
Return
End Subroutine psb_dcdbldext

47
base/tools/psb_dfree.f90
Unescape Escape View File

@ -48,7 +48,7 @@ subroutine psb_dfree(x, desc_a, info)
integer(psb_ipk_), intent(out) :: info
!...locals....
integer(psb_ipk_) :: ictxt,np,me,err_act
integer(psb_ipk_) :: ictxt,np,me, err_act
character(len=20) :: name
@ -59,10 +59,10 @@ subroutine psb_dfree(x, desc_a, info)
if (.not.psb_is_ok_desc(desc_a)) then
info=psb_err_forgot_spall_
call psb_errpush(info,name)
goto 9999
return
end if
ictxt = desc_a%get_context()
ictxt=desc_a%get_context()
call psb_info(ictxt, me, np)
! ....verify blacs grid correctness..
@ -90,12 +90,8 @@ subroutine psb_dfree(x, desc_a, info)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_dfree
@ -116,8 +112,9 @@ subroutine psb_dfreev(x, desc_a, info)
real(psb_dpk_),allocatable, intent(inout) :: x(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
!...locals....
integer(psb_ipk_) :: ictxt,np,me,err_act
integer(psb_ipk_) :: ictxt,np,me, err_act
character(len=20) :: name
@ -126,18 +123,20 @@ subroutine psb_dfreev(x, desc_a, info)
call psb_erractionsave(err_act)
name='psb_dfreev'
if (.not.psb_is_ok_desc(desc_a)) then
info=psb_err_forgot_spall_
call psb_errpush(info,name)
return
goto 9999
end if
ictxt = desc_a%get_context()
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)) then
@ -156,12 +155,8 @@ subroutine psb_dfreev(x, desc_a, info)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_dfreev
@ -214,12 +209,8 @@ subroutine psb_dfree_vect(x, desc_a, info)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_dfree_vect
@ -269,12 +260,8 @@ subroutine psb_dfree_vect_r2(x, desc_a, info)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_dfree_vect_r2

40
base/tools/psb_dins.f90
Unescape Escape View File

@ -171,14 +171,8 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl,local)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_ret_) then
return
else
call psb_error(ictxt)
end if
return
end subroutine psb_dinsvi
@ -292,14 +286,8 @@ subroutine psb_dins_vect(m, irw, val, x, desc_a, info, dupl,local)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_ret_) then
return
else
call psb_error(ictxt)
end if
return
end subroutine psb_dins_vect
@ -408,14 +396,8 @@ subroutine psb_dins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_ret_) then
return
else
call psb_error(ictxt)
end if
return
end subroutine psb_dins_vect_v
@ -533,14 +515,8 @@ subroutine psb_dins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_ret_) then
return
else
call psb_error(ictxt)
end if
return
end subroutine psb_dins_vect_r2
@ -730,14 +706,8 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl,local)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_ret_) then
return
else
call psb_error(ictxt)
end if
return
end subroutine psb_dinsi

20
base/tools/psb_dspalloc.f90
Unescape Escape View File

@ -59,19 +59,13 @@ subroutine psb_dspalloc(a, desc_a, info, nnz)
integer(psb_ipk_) :: 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()
@ -107,11 +101,11 @@ subroutine psb_dspalloc(a, desc_a, info, nnz)
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),':allocating size:',length_ia1
call a%free()
!....allocate aspk, ia1, ia2.....
call a%csall(loc_row,loc_col,info,nz=length_ia1)
if (psb_errstatus_fatal()) then
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='sp_all'
call psb_errpush(info,name,int_err)
goto 9999
end if
@ -125,14 +119,8 @@ subroutine psb_dspalloc(a, desc_a, info, nnz)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_ret_) then
return
else
call psb_error(ictxt)
end if
return
end subroutine psb_dspalloc

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

@ -140,12 +140,8 @@ subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl, mold)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_dspasb

21
base/tools/psb_dspfree.f90
Unescape Escape View File

@ -48,7 +48,7 @@ subroutine psb_dspfree(a, desc_a,info)
type(psb_dspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info
!...locals....
integer(psb_ipk_) :: ictxt,err_act
integer(psb_ipk_) :: ictxt, err_act
character(len=20) :: name
if(psb_get_errstatus() /= 0) return
@ -56,31 +56,22 @@ subroutine psb_dspfree(a, desc_a,info)
name = 'psb_dspfree'
call psb_erractionsave(err_act)
if (.not.desc_a%is_ok()) then
info = psb_err_invalid_cd_state_
if (.not.psb_is_ok_desc(desc_a)) then
info = psb_err_forgot_spall_
call psb_errpush(info,name)
goto 9999
return
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
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_dspfree

8
base/tools/psb_dsphalo.F90
Unescape Escape View File

@ -366,12 +366,8 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
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
9999 call psb_error_handler(ictxt,err_act)
return
End Subroutine psb_dsphalo

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

@ -193,12 +193,8 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_dspins
@ -313,12 +309,8 @@ subroutine psb_dspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_dspins_2desc
@ -472,12 +464,8 @@ subroutine psb_dspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_dspins_v

38
base/tools/psb_sallc.f90
Unescape Escape View File

@ -56,7 +56,7 @@ subroutine psb_salloc(x, desc_a, info, n, lb)
!locals
integer(psb_ipk_) :: np,me,err,nr,i,j,err_act
integer(psb_ipk_) :: ictxt,n_
integer(psb_ipk_) :: int_err(5), exch(3)
integer(psb_ipk_) :: int_err(5),exch(3)
character(len=20) :: name
name='psb_geall'
@ -125,12 +125,8 @@ subroutine psb_salloc(x, desc_a, info, n, lb)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_salloc
@ -167,9 +163,8 @@ end subroutine psb_salloc
!!$
!!$
!
!
! Function: psb_sallocv
! Allocates dense matrix for PSBLAS routines.
! Allocates dense matrix for PSBLAS routines
! The descriptor may be in either the build or assembled state.
!
! Arguments:
@ -243,16 +238,13 @@ subroutine psb_sallocv(x, desc_a,info,n)
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
9999 call psb_error_handler(ictxt,err_act)
return
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
@ -320,12 +312,8 @@ subroutine psb_salloc_vect(x, desc_a,info,n)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_salloc_vect
@ -427,12 +415,8 @@ subroutine psb_salloc_vect_r2(x, desc_a,info,n,lb)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_salloc_vect_r2

42
base/tools/psb_sasb.f90
Unescape Escape View File

@ -32,14 +32,14 @@
! File: psb_sasb.f90
!
! Subroutine: psb_sasb
! Assembles a dense matrix for PSBLAS routines.
! Assembles a dense matrix for PSBLAS routines
! Since the allocation may have been called with the desciptor
! in the build state we make sure that X has a number of rows
! allowing for the halo indices, reallocating if necessary.
! We also call the halo routine for good measure.
!
! Arguments:
! x(:,:) - real,allocatable The matrix to be assembled.
! x(:,:) - real, allocatable The matrix to be assembled.
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. return code
subroutine psb_sasb(x, desc_a, info)
@ -83,8 +83,7 @@ subroutine psb_sasb(x, desc_a, info)
goto 9999
else if (.not.psb_is_asb_desc(desc_a)) then
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),' error ',&
& desc_a%get_dectype()
& write(debug_unit,*) me,' ',trim(name),' error '
info = psb_err_input_matrix_unassembled_
call psb_errpush(info,name)
goto 9999
@ -122,12 +121,8 @@ subroutine psb_sasb(x, desc_a, info)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_sasb
@ -172,7 +167,7 @@ end subroutine psb_sasb
! We also call the halo routine for good measure.
!
! Arguments:
! x(:) - real,allocatable The matrix to be assembled.
! x(:) - real, allocatable The matrix to be assembled.
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code
subroutine psb_sasbv(x, desc_a, info)
@ -240,16 +235,13 @@ subroutine psb_sasbv(x, desc_a, info)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_sasbv
subroutine psb_sasb_vect(x, desc_a, info, mold, scratch)
use psb_base_mod, psb_protect_name => psb_sasb_vect
implicit none
@ -319,12 +311,8 @@ subroutine psb_sasb_vect(x, desc_a, info, mold, scratch)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_sasb_vect
@ -407,12 +395,8 @@ subroutine psb_sasb_vect_r2(x, desc_a, info, mold, scratch)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_sasb_vect_r2

8
base/tools/psb_scdbldext.F90
Unescape Escape View File

@ -716,13 +716,9 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
9999 call psb_error_handler(ictxt,err_act)
return
end if
Return
End Subroutine psb_scdbldext

51
base/tools/psb_sfree.f90
Unescape Escape View File

@ -45,10 +45,10 @@ subroutine psb_sfree(x, desc_a, info)
!....parameters...
real(psb_spk_),allocatable, intent(inout) :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), intent(out) :: info
!...locals....
integer(psb_ipk_) :: ictxt,np,me,err_act
integer(psb_ipk_) :: ictxt,np,me, err_act
character(len=20) :: name
@ -59,10 +59,10 @@ subroutine psb_sfree(x, desc_a, info)
if (.not.psb_is_ok_desc(desc_a)) then
info=psb_err_forgot_spall_
call psb_errpush(info,name)
goto 9999
return
end if
ictxt = desc_a%get_context()
ictxt=desc_a%get_context()
call psb_info(ictxt, me, np)
! ....verify blacs grid correctness..
@ -90,12 +90,8 @@ subroutine psb_sfree(x, desc_a, info)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_sfree
@ -106,7 +102,7 @@ end subroutine psb_sfree
! frees a dense matrix structure
!
! Arguments:
! x():) - real, allocatable The dense matrix to be freed.
! x(:) - real, allocatable The dense matrix to be freed.
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code
subroutine psb_sfreev(x, desc_a, info)
@ -116,8 +112,9 @@ subroutine psb_sfreev(x, desc_a, info)
real(psb_spk_),allocatable, intent(inout) :: x(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
!...locals....
integer(psb_ipk_) :: ictxt,np,me,err_act
integer(psb_ipk_) :: ictxt,np,me, err_act
character(len=20) :: name
@ -126,18 +123,20 @@ subroutine psb_sfreev(x, desc_a, info)
call psb_erractionsave(err_act)
name='psb_sfreev'
if (.not.psb_is_ok_desc(desc_a)) then
info=psb_err_forgot_spall_
call psb_errpush(info,name)
return
goto 9999
end if
ictxt = desc_a%get_context()
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)) then
@ -156,12 +155,8 @@ subroutine psb_sfreev(x, desc_a, info)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_sfreev
@ -214,12 +209,8 @@ subroutine psb_sfree_vect(x, desc_a, info)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_sfree_vect
@ -269,12 +260,8 @@ subroutine psb_sfree_vect_r2(x, desc_a, info)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_sfree_vect_r2

40
base/tools/psb_sins.f90
Unescape Escape View File

@ -171,14 +171,8 @@ subroutine psb_sinsvi(m, irw, val, x, desc_a, info, dupl,local)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_ret_) then
return
else
call psb_error(ictxt)
end if
return
end subroutine psb_sinsvi
@ -292,14 +286,8 @@ subroutine psb_sins_vect(m, irw, val, x, desc_a, info, dupl,local)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_ret_) then
return
else
call psb_error(ictxt)
end if
return
end subroutine psb_sins_vect
@ -408,14 +396,8 @@ subroutine psb_sins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_ret_) then
return
else
call psb_error(ictxt)
end if
return
end subroutine psb_sins_vect_v
@ -533,14 +515,8 @@ subroutine psb_sins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_ret_) then
return
else
call psb_error(ictxt)
end if
return
end subroutine psb_sins_vect_r2
@ -730,14 +706,8 @@ subroutine psb_sinsi(m, irw, val, x, desc_a, info, dupl,local)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_ret_) then
return
else
call psb_error(ictxt)
end if
return
end subroutine psb_sinsi

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

@ -119,14 +119,8 @@ subroutine psb_sspalloc(a, desc_a, info, nnz)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_ret_) then
return
else
call psb_error(ictxt)
end if
return
end subroutine psb_sspalloc

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

@ -140,12 +140,8 @@ subroutine psb_sspasb(a,desc_a, info, afmt, upd, dupl, mold)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_sspasb

12
base/tools/psb_sspfree.f90
Unescape Escape View File

@ -48,7 +48,7 @@ subroutine psb_sspfree(a, desc_a,info)
type(psb_sspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info
!...locals....
integer(psb_ipk_) :: ictxt,err_act
integer(psb_ipk_) :: ictxt, err_act
character(len=20) :: name
if(psb_get_errstatus() /= 0) return
@ -57,7 +57,7 @@ subroutine psb_sspfree(a, desc_a,info)
call psb_erractionsave(err_act)
if (.not.psb_is_ok_desc(desc_a)) then
info=psb_err_forgot_spall_
info = psb_err_forgot_spall_
call psb_errpush(info,name)
return
else
@ -70,12 +70,8 @@ subroutine psb_sspfree(a, desc_a,info)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_sspfree

8
base/tools/psb_ssphalo.F90
Unescape Escape View File

@ -366,12 +366,8 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
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
9999 call psb_error_handler(ictxt,err_act)
return
End Subroutine psb_ssphalo

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

@ -193,12 +193,8 @@ subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild,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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_sspins
@ -313,12 +309,8 @@ subroutine psb_sspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_sspins_2desc
@ -472,12 +464,8 @@ subroutine psb_sspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_sspins_v

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

@ -125,12 +125,8 @@ subroutine psb_zalloc(x, desc_a, info, n, lb)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_zalloc
@ -242,12 +238,8 @@ subroutine psb_zallocv(x, desc_a,info,n)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_zallocv
@ -320,12 +312,8 @@ subroutine psb_zalloc_vect(x, desc_a,info,n)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_zalloc_vect
@ -427,12 +415,8 @@ subroutine psb_zalloc_vect_r2(x, desc_a,info,n,lb)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_zalloc_vect_r2

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

@ -121,12 +121,8 @@ subroutine psb_zasb(x, desc_a, info)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_zasb
@ -239,12 +235,8 @@ subroutine psb_zasbv(x, desc_a, info)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_zasbv
@ -319,12 +311,8 @@ subroutine psb_zasb_vect(x, desc_a, info, mold, scratch)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_zasb_vect
@ -407,12 +395,8 @@ subroutine psb_zasb_vect_r2(x, desc_a, info, mold, scratch)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_zasb_vect_r2

8
base/tools/psb_zcdbldext.F90
Unescape Escape View File

@ -716,13 +716,9 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
9999 call psb_error_handler(ictxt,err_act)
return
end if
Return
End Subroutine psb_zcdbldext

32
base/tools/psb_zfree.f90
Unescape Escape View File

@ -90,12 +90,8 @@ subroutine psb_zfree(x, desc_a, info)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_zfree
@ -159,14 +155,8 @@ subroutine psb_zfreev(x, desc_a, info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_ret_) then
return
else
call psb_error(ictxt)
end if
return
end subroutine psb_zfreev
@ -219,12 +209,8 @@ subroutine psb_zfree_vect(x, desc_a, info)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_zfree_vect
@ -274,12 +260,8 @@ subroutine psb_zfree_vect_r2(x, desc_a, info)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_zfree_vect_r2

40
base/tools/psb_zins.f90
Unescape Escape View File

@ -171,14 +171,8 @@ subroutine psb_zinsvi(m, irw, val, x, desc_a, info, dupl,local)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_ret_) then
return
else
call psb_error(ictxt)
end if
return
end subroutine psb_zinsvi
@ -292,14 +286,8 @@ subroutine psb_zins_vect(m, irw, val, x, desc_a, info, dupl,local)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_ret_) then
return
else
call psb_error(ictxt)
end if
return
end subroutine psb_zins_vect
@ -408,14 +396,8 @@ subroutine psb_zins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_ret_) then
return
else
call psb_error(ictxt)
end if
return
end subroutine psb_zins_vect_v
@ -533,14 +515,8 @@ subroutine psb_zins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_ret_) then
return
else
call psb_error(ictxt)
end if
return
end subroutine psb_zins_vect_r2
@ -730,14 +706,8 @@ subroutine psb_zinsi(m, irw, val, x, desc_a, info, dupl,local)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_ret_) then
return
else
call psb_error(ictxt)
end if
return
end subroutine psb_zinsi

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

@ -119,14 +119,8 @@ subroutine psb_zspalloc(a, desc_a, info, nnz)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_ret_) then
return
else
call psb_error(ictxt)
end if
return
end subroutine psb_zspalloc

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

@ -140,12 +140,8 @@ subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl, mold)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_zspasb

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

@ -70,12 +70,8 @@ subroutine psb_zspfree(a, desc_a,info)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_zspfree

8
base/tools/psb_zsphalo.F90
Unescape Escape View File

@ -366,12 +366,8 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
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
9999 call psb_error_handler(ictxt,err_act)
return
End Subroutine psb_zsphalo

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

@ -193,12 +193,8 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild,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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_zspins
@ -313,12 +309,8 @@ subroutine psb_zspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_zspins_2desc
@ -472,12 +464,8 @@ subroutine psb_zspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,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
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psb_zspins_v

Write Preview
Loading…
Cancel
Save