mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-21 05:12:13 +00:00
Fixed: must on ALLOCATE() to properly handle error conditions.
This commit is contained in:
Salvatore Filippone
@@ -171,7 +171,13 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, iroot,&
|
||||
end if
|
||||
|
||||
! root has to gather size information
|
||||
allocate(displ(nprow),all_dim(nprow))
|
||||
allocate(displ(nprow),all_dim(nprow),stat=info)
|
||||
if(info.ne.0) then
|
||||
info=4010
|
||||
ch_err='Allocate'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
call mpi_gather(nrow,1,mpi_integer,all_dim,&
|
||||
& nprow,mpi_integer,rootrank,icomm,info)
|
||||
|
||||
@@ -180,7 +186,14 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, iroot,&
|
||||
|
||||
! root has to gather loc_glob from each process
|
||||
if(myrow.eq.root) then
|
||||
allocate(l_t_g_all(sum(all_dim)),scatterv(sum(all_dim)))
|
||||
allocate(l_t_g_all(sum(all_dim)),scatterv(sum(all_dim)),stat=info)
|
||||
if(info.ne.0) then
|
||||
info=4010
|
||||
ch_err='Allocate'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
end if
|
||||
|
||||
call mpi_gatherv(desc_a%loc_to_glob,nrow,&
|
||||
|
||||
@@ -15,7 +15,7 @@ subroutine psi_compute_size(desc_data,&
|
||||
! ...local array...
|
||||
integer :: exch(2)
|
||||
integer :: int_err(5)
|
||||
integer, pointer :: counter_recv(:), counter_dl(:)
|
||||
integer, allocatable :: counter_recv(:), counter_dl(:)
|
||||
|
||||
! ...parameters
|
||||
logical, parameter :: debug=.false.
|
||||
@@ -40,7 +40,12 @@ subroutine psi_compute_size(desc_data,&
|
||||
endif
|
||||
|
||||
np=nprow
|
||||
allocate(counter_dl(0:np-1),counter_recv(0:np-1))
|
||||
allocate(counter_dl(0:np-1),counter_recv(0:np-1),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
! ..initialize counters...
|
||||
do i=0,np-1
|
||||
counter_recv(i)=0
|
||||
|
||||
@@ -50,7 +50,12 @@ subroutine psi_crea_bnd_elem(desc_a,info)
|
||||
j = 0
|
||||
endif
|
||||
|
||||
allocate(desc_a%bnd_elem(j+1))
|
||||
allocate(desc_a%bnd_elem(j+1),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (.false.) then
|
||||
desc_a%bnd_elem(1) = j
|
||||
desc_a%bnd_elem(2:j+1) = work(1:j)
|
||||
|
||||
@@ -77,7 +77,12 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,info)
|
||||
! the number of processors becomes very high
|
||||
dl_lda=np+1
|
||||
|
||||
allocate(dep_list(max(1,dl_lda),0:np),length_dl(0:np))
|
||||
allocate(dep_list(max(1,dl_lda),0:np),length_dl(0:np),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
! ...extract dependence list (ordered list of identifer process
|
||||
! which every process must communcate with...
|
||||
if (debug) write(*,*) 'crea_halo: calling extract_dep_list'
|
||||
|
||||
@@ -222,7 +222,8 @@ c$$$ + i, i, -ione ,-ione,-ione)
|
||||
if (.true.) then
|
||||
call igsum2d(icontxt,'all',' ',np+1,1,length_dl,np+1,-1,-1)
|
||||
call blacs_get(icontxt,10,icomm )
|
||||
allocate(itmp(dl_lda))
|
||||
allocate(itmp(dl_lda),stat=info)
|
||||
if (info /= 0) goto 9999
|
||||
itmp(1:dl_lda) = dep_list(1:dl_lda,me)
|
||||
call mpi_allgather(itmp,dl_lda,mpi_integer,
|
||||
+ dep_list,dl_lda,mpi_integer,icomm,info)
|
||||
|
||||
@@ -317,7 +317,7 @@ contains
|
||||
|
||||
name='smooth_aggregate'
|
||||
if(psb_get_errstatus().ne.0) return
|
||||
info=0
|
||||
info=0
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
icontxt = desc_a%matrix_data(psb_ctxt_)
|
||||
@@ -338,6 +338,10 @@ contains
|
||||
ntaggr = sum(p%nlaggr)
|
||||
|
||||
allocate(nzbr(np), idisp(np),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
|
||||
naggrm1 = sum(p%nlaggr(1:myprow))
|
||||
@@ -371,9 +375,10 @@ contains
|
||||
! nrow: local rows.
|
||||
!
|
||||
allocate(p%dorig(nrow),stat=info)
|
||||
if (info/=0) then
|
||||
write(0,*) 'Error from allocation',info
|
||||
endif
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
! Get diagonal D
|
||||
call psb_spgtdiag(a,p%dorig,info)
|
||||
@@ -662,7 +667,11 @@ contains
|
||||
nzbg = bg%infoa(psb_nnz_)
|
||||
nzl = bg%infoa(psb_nnz_)
|
||||
|
||||
allocate(ivall(ntaggr))
|
||||
allocate(ivall(ntaggr),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
i = 1
|
||||
do ip=1,nprows
|
||||
|
||||
+34
-7
@@ -132,7 +132,11 @@ subroutine psb_dcslu(a,desc_a,p,upd,info)
|
||||
endif
|
||||
|
||||
if (.not.associated(p%av)) then
|
||||
allocate(p%av(bp_ilu_avsz))
|
||||
allocate(p%av(bp_ilu_avsz),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
endif
|
||||
do k=1,size(p%av)
|
||||
call psb_nullify_sp(p%av(k))
|
||||
@@ -169,6 +173,11 @@ subroutine psb_dcslu(a,desc_a,p,upd,info)
|
||||
endif
|
||||
if (.not.associated(p%d)) then
|
||||
allocate(p%d(n_row),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
endif
|
||||
|
||||
|
||||
@@ -319,7 +328,7 @@ contains
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
if(psb_get_errstatus().ne.0) return
|
||||
info=0
|
||||
info=0
|
||||
name='apply_renum'
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
@@ -343,7 +352,12 @@ contains
|
||||
!
|
||||
|
||||
nnr = p%desc_data%matrix_data(psb_n_row_)
|
||||
allocate(p%perm(nnr),p%invperm(nnr),itmp2(nnr))
|
||||
allocate(p%perm(nnr),p%invperm(nnr),itmp2(nnr),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
do k=1,nnr
|
||||
itmp2(k) = p%desc_data%loc_to_glob(k)
|
||||
enddo
|
||||
@@ -359,8 +373,12 @@ contains
|
||||
|
||||
! Build ATMP with new numbering.
|
||||
|
||||
allocate(itmp(max(8,atmp%m+2,nztmp+2)),rtmp(atmp%m))
|
||||
|
||||
allocate(itmp(max(8,atmp%m+2,nztmp+2)),rtmp(atmp%m),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
j = 1
|
||||
atmp%ia2(1) = 1
|
||||
do i=1, atmp%m
|
||||
@@ -480,7 +498,12 @@ contains
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
allocate(itmp(max(8,atmp%m+2,nztmp+2)))
|
||||
allocate(itmp(max(8,atmp%m+2,nztmp+2)),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
itmp(1:8) = 0
|
||||
! write(0,*) me,' Renumbering: Calling Metis'
|
||||
! call blacs_barrier(icontxt,'All')
|
||||
@@ -512,7 +535,11 @@ contains
|
||||
|
||||
! Build ATMP with new numbering.
|
||||
|
||||
allocate(itmp2(max(8,atmp%m+2,nztmp+2)),rtmp(atmp%m))
|
||||
allocate(itmp2(max(8,atmp%m+2,nztmp+2)),rtmp(atmp%m),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
j = 1
|
||||
atmp%ia2(1) = 1
|
||||
|
||||
+88
-15
@@ -68,7 +68,12 @@ subroutine psb_dprecaply(prec,x,y,desc_data,info,trans, work)
|
||||
if (present(work)) then
|
||||
work_ => work
|
||||
else
|
||||
allocate(work_(4*desc_data%matrix_data(psb_n_col_)))
|
||||
allocate(work_(4*desc_data%matrix_data(psb_n_col_)),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
end if
|
||||
|
||||
if (.not.(associated(prec%baseprecv))) then
|
||||
@@ -235,15 +240,29 @@ subroutine psb_dbaseprcaply(prec,x,beta,y,desc_data,trans,work,info)
|
||||
aux => work(3*isz+1:)
|
||||
else if ((4*isz) <= size(work)) then
|
||||
aux => work(1:)
|
||||
allocate(ww(isz),tx(isz),ty(isz))
|
||||
allocate(ww(isz),tx(isz),ty(isz),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
else if ((3*isz) <= size(work)) then
|
||||
ww => work(1:isz)
|
||||
tx => work(isz+1:2*isz)
|
||||
ty => work(2*isz+1:3*isz)
|
||||
allocate(aux(4*isz))
|
||||
allocate(aux(4*isz),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
else
|
||||
allocate(ww(isz),tx(isz),ty(isz),&
|
||||
&aux(4*isz))
|
||||
&aux(4*isz),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
endif
|
||||
|
||||
if (debug) write(0,*)' vdiag: ',prec%d(:)
|
||||
@@ -416,10 +435,19 @@ subroutine psb_dbjacaply(prec,x,beta,y,desc_data,trans,work,info)
|
||||
if ((4*n_col+n_col) <= size(work)) then
|
||||
aux => work(n_col+1:)
|
||||
else
|
||||
allocate(aux(4*n_col))
|
||||
allocate(aux(4*n_col),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
endif
|
||||
else
|
||||
allocate(ww(n_col),aux(4*n_col))
|
||||
allocate(ww(n_col),aux(4*n_col),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
endif
|
||||
|
||||
|
||||
@@ -509,7 +537,12 @@ subroutine psb_dbjacaply(prec,x,beta,y,desc_data,trans,work,info)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
allocate(tx(n_col),ty(n_col))
|
||||
allocate(tx(n_col),ty(n_col),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
tx = zero
|
||||
ty = zero
|
||||
select case(prec%iprcparm(f_type_))
|
||||
@@ -684,7 +717,12 @@ subroutine psb_dmlprcaply(baseprecv,x,beta,y,desc_data,trans,work,info)
|
||||
|
||||
nr2l = baseprecv(2)%desc_data%matrix_data(psb_n_col_)
|
||||
nrg = baseprecv(2)%desc_data%matrix_data(psb_n_row_)
|
||||
allocate(t2l(nr2l),w2l(nr2l))
|
||||
allocate(t2l(nr2l),w2l(nr2l),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
t2l(:) = zero
|
||||
w2l(:) = zero
|
||||
|
||||
@@ -693,7 +731,12 @@ subroutine psb_dmlprcaply(baseprecv,x,beta,y,desc_data,trans,work,info)
|
||||
! Smoothed aggregation
|
||||
!
|
||||
allocate(tx(max(n_row,n_col)),ty(max(n_row,n_col)),&
|
||||
& tz(max(n_row,n_col)))
|
||||
& tz(max(n_row,n_col)),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
tx(1:desc_data%matrix_data(psb_n_row_)) = x(1:desc_data%matrix_data(psb_n_row_))
|
||||
tx(desc_data%matrix_data(psb_n_row_)+1:max(n_row,n_col)) = zero
|
||||
ty(desc_data%matrix_data(psb_n_row_)+1:max(n_row,n_col)) = zero
|
||||
@@ -770,7 +813,12 @@ subroutine psb_dmlprcaply(baseprecv,x,beta,y,desc_data,trans,work,info)
|
||||
n_col = baseprecv(1)%desc_data%matrix_data(psb_n_col_)
|
||||
nr2l = baseprecv(2)%desc_data%matrix_data(psb_n_col_)
|
||||
nrg = baseprecv(2)%desc_data%matrix_data(psb_n_row_)
|
||||
allocate(t2l(nr2l),w2l(nr2l),tx(n_col),ty(n_col))
|
||||
allocate(t2l(nr2l),w2l(nr2l),tx(n_col),ty(n_col),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
t2l(:) = zero
|
||||
w2l(:) = zero
|
||||
|
||||
@@ -788,7 +836,12 @@ subroutine psb_dmlprcaply(baseprecv,x,beta,y,desc_data,trans,work,info)
|
||||
!
|
||||
! Smoothed aggregation
|
||||
!
|
||||
allocate(tz(max(n_row,n_col)))
|
||||
allocate(tz(max(n_row,n_col)),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
|
||||
if (baseprecv(2)%iprcparm(glb_smth_) >0) then
|
||||
call psb_halo(tx,desc_data,info,work=work)
|
||||
@@ -859,7 +912,12 @@ subroutine psb_dmlprcaply(baseprecv,x,beta,y,desc_data,trans,work,info)
|
||||
n_col = baseprecv(1)%desc_data%matrix_data(psb_n_col_)
|
||||
nr2l = baseprecv(2)%desc_data%matrix_data(psb_n_col_)
|
||||
nrg = baseprecv(2)%desc_data%matrix_data(psb_n_row_)
|
||||
allocate(t2l(nr2l),w2l(nr2l),tx(n_col),ty(n_col),tty(n_col))
|
||||
allocate(t2l(nr2l),w2l(nr2l),tx(n_col),ty(n_col),tty(n_col),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
t2l(:) = zero
|
||||
w2l(:) = zero
|
||||
|
||||
@@ -878,7 +936,12 @@ subroutine psb_dmlprcaply(baseprecv,x,beta,y,desc_data,trans,work,info)
|
||||
if(info /=0) goto 9999
|
||||
|
||||
if (ismth /= no_smth_) then
|
||||
allocate(tz(max(n_row,n_col)))
|
||||
allocate(tz(max(n_row,n_col)),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
|
||||
if (baseprecv(2)%iprcparm(glb_smth_) >0) then
|
||||
call psb_halo(tx,desc_data,info,work=work)
|
||||
@@ -943,7 +1006,12 @@ subroutine psb_dmlprcaply(baseprecv,x,beta,y,desc_data,trans,work,info)
|
||||
n_col = baseprecv(1)%desc_data%matrix_data(psb_n_col_)
|
||||
nr2l = baseprecv(2)%desc_data%matrix_data(psb_n_col_)
|
||||
nrg = baseprecv(2)%desc_data%matrix_data(psb_n_row_)
|
||||
allocate(t2l(nr2l),w2l(nr2l),tx(n_col),ty(n_col),tty(n_col))
|
||||
allocate(t2l(nr2l),w2l(nr2l),tx(n_col),ty(n_col),tty(n_col),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
t2l(:) = zero
|
||||
w2l(:) = zero
|
||||
tx(:) = zero
|
||||
@@ -1091,7 +1159,12 @@ subroutine psb_dprecaply1(prec,x,desc_data,info,trans)
|
||||
trans_='N'
|
||||
end if
|
||||
|
||||
allocate(ww(size(x)),w1(size(x)))
|
||||
allocate(ww(size(x)),w1(size(x)),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_dprecaply(prec,x,ww,desc_data,info,trans_,w1)
|
||||
if(info /=0) goto 9999
|
||||
x(:) = ww(:)
|
||||
|
||||
@@ -109,7 +109,12 @@ subroutine psb_dprecbld(a,p,desc_a,info,upd)
|
||||
|
||||
call psb_check_def(p%baseprecv(1)%iprcparm(p_type_),'base_prec',&
|
||||
& diagsc_,is_legal_base_prec)
|
||||
allocate(p%baseprecv(1)%desc_data)
|
||||
allocate(p%baseprecv(1)%desc_data,stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_nullify_desc(p%baseprecv(1)%desc_data)
|
||||
|
||||
select case(p%baseprecv(1)%iprcparm(p_type_))
|
||||
@@ -169,7 +174,12 @@ subroutine psb_dprecbld(a,p,desc_a,info,upd)
|
||||
endif
|
||||
|
||||
if (debug) then
|
||||
allocate(gd(mglob))
|
||||
allocate(gd(mglob),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_gather(gd, p%baseprecv(1)%d, desc_a, info, iroot=iroot)
|
||||
if(info /= 0) then
|
||||
info=4010
|
||||
@@ -269,7 +279,12 @@ subroutine psb_dprecbld(a,p,desc_a,info,upd)
|
||||
& pre_smooth_,is_legal_ml_smooth_pos)
|
||||
call psb_check_def(p%baseprecv(2)%iprcparm(f_type_),'fact',f_ilu_n_,is_legal_ml_fact)
|
||||
|
||||
allocate(p%baseprecv(2)%desc_data)
|
||||
allocate(p%baseprecv(2)%desc_data,stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_nullify_desc(p%baseprecv(2)%desc_data)
|
||||
|
||||
select case(p%baseprecv(2)%iprcparm(f_type_))
|
||||
@@ -728,8 +743,12 @@ subroutine psb_mlprec_bld(a,desc_a,p,info)
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
p%aorig => a
|
||||
allocate(p%av(smth_avsz))
|
||||
|
||||
allocate(p%av(smth_avsz),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
do i=1, smth_avsz
|
||||
call psb_nullify_sp(p%av(i))
|
||||
call psb_spall(0,0,p%av(i),1,info)
|
||||
@@ -770,7 +789,11 @@ subroutine psb_mlprec_bld(a,desc_a,p,info)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
allocate(p%d(nrg))
|
||||
allocate(p%d(nrg),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
select case(p%iprcparm(f_type_))
|
||||
case(f_ilu_n_,f_ilu_e_)
|
||||
|
||||
@@ -1,3 +1,4 @@
|
||||
|
||||
subroutine psb_dprecset(p,ptype,iv,rs,rv,info)
|
||||
|
||||
use psb_serial_mod
|
||||
@@ -30,7 +31,7 @@ subroutine psb_dprecset(p,ptype,iv,rs,rv,info)
|
||||
endif
|
||||
end if
|
||||
|
||||
select case(toupper(ptype))
|
||||
select case(toupper(ptype(1:len_trim(ptype))))
|
||||
case ('NONE','NOPREC')
|
||||
p%baseprecv(1)%iprcparm(p_type_) = noprec_
|
||||
p%baseprecv(1)%iprcparm(f_type_) = f_none_
|
||||
@@ -85,7 +86,10 @@ subroutine psb_dprecset(p,ptype,iv,rs,rv,info)
|
||||
select case (size(p%baseprecv))
|
||||
case(1)
|
||||
! Reallocate
|
||||
allocate(bpv(2))
|
||||
allocate(bpv(2),stat=err)
|
||||
if (err/=0) then
|
||||
write(0,*)'Precset Memory Failure 2l:1',err
|
||||
endif
|
||||
bpv(1) = p%baseprecv(1)
|
||||
call psb_nullify_baseprec(bpv(2))
|
||||
deallocate(p%baseprecv)
|
||||
|
||||
@@ -33,7 +33,12 @@ subroutine psb_dsplu(a,l,u,d,info,blck)
|
||||
if (present(blck)) then
|
||||
blck_ => blck
|
||||
else
|
||||
allocate(blck_)
|
||||
allocate(blck_,stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_nullify_sp(blck_) ! Why do we need this? Who knows....
|
||||
call psb_spall(0,0,blck_,1,info)
|
||||
if(info.ne.0) then
|
||||
|
||||
@@ -42,7 +42,12 @@ subroutine psb_dipcoo2csr(a,info,rwshr)
|
||||
call psb_fixcoo(a,info)
|
||||
nr = a%m
|
||||
nza = a%infoa(psb_nnz_)
|
||||
allocate(iaux(nr+1))
|
||||
allocate(iaux(nr+1),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if(debug) write(0,*)'DIPCOO2CSR: out of fixcoo',nza,nr,size(a%ia2),size(iaux)
|
||||
|
||||
itemp => a%ia1
|
||||
|
||||
@@ -83,7 +83,11 @@ Subroutine psb_descasb(n_ovr,desc_p,desc_a,a,&
|
||||
lwork=5*(5*np+2)*np+10
|
||||
Allocate(works(lworks),workr(lworkr),t_halo_in(3*Size(desc_p%halo_index)),&
|
||||
& t_halo_out(Size(desc_p%halo_index)), work(lwork),&
|
||||
& length_dl(np+1),dep_list(dl_lda*np),temp(lworkr))
|
||||
& length_dl(np+1),dep_list(dl_lda*np),temp(lworkr),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
|
||||
call psb_spall(blk,max(lworks,lworkr),info)
|
||||
@@ -97,7 +101,12 @@ Subroutine psb_descasb(n_ovr,desc_p,desc_a,a,&
|
||||
blk%fida='COO'
|
||||
halo => desc_a%halo_index
|
||||
|
||||
Allocate(tmp_ovr_idx(l_tmp_ovr_idx),tmp_halo(l_tmp_halo))
|
||||
Allocate(tmp_ovr_idx(l_tmp_ovr_idx),tmp_halo(l_tmp_halo),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
desc_p%ovrlap_elem(:) = -1
|
||||
tmp_ovr_idx(:) = -1
|
||||
tmp_halo(:) = -1
|
||||
|
||||
@@ -250,6 +250,11 @@ subroutine psb_dscall(m, n, parts, icontxt, desc_a, info)
|
||||
loc_col=int((psb_colrow_+1.d0)*loc_row)+1
|
||||
allocate(desc_a%loc_to_glob(loc_col),&
|
||||
&desc_a%lprm(1),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_realloc(1, desc_a%lprm, info)
|
||||
call psb_realloc(loc_col, desc_a%loc_to_glob, info)
|
||||
if (info /= no_err) then
|
||||
|
||||
Reference in New Issue
Block a user