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

Fixed error checks on temp allocation.

Browse Source
This commit is contained in:
Salvatore Filippone
2007-06-04 16:19:24 +00:00
parent 3be4f105f8
commit 5abf0cd2c1
6 changed files with 27 additions and 13 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/serial/psb_dipcoo2csc.f90
+6 -1
View File
@@ -74,7 +74,12 @@ subroutine psb_dipcoo2csc(a,info,clshr)
call psb_fixcoo(a,info,idir=1)
nc = a%k
nza = a%infoa(psb_nnz_)
allocate(iaux(nc+1))
allocate(iaux(max(nc+1,1)),stat=info)
if (info /= 0) then
info=4025
call psb_errpush(info,name,a_err='integer',i_err=(/max(nc+1,1),0,0,0,0/))
goto 9999
end if
if(debug) write(0,*)'DIPCOO2CSC: out of fixcoo',nza,nc,size(a%ia2),size(iaux)
call psb_transfer(a%ia2,itemp,info)
base/serial/psb_dipcoo2csr.f90
+2 -1
View File
@@ -76,7 +76,8 @@ subroutine psb_dipcoo2csr(a,info,rwshr)
nza = a%infoa(psb_nnz_)
allocate(iaux(max(nr+1,1)),stat=info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate')
info=4025
call psb_errpush(info,name,a_err='integer',i_err=(/max(nr+1,1),0,0,0,0/))
goto 9999
end if
base/serial/psb_dipcsr2coo.f90
+5 -4
View File
@@ -63,10 +63,11 @@ Subroutine psb_dipcsr2coo(a,info)
nr = a%m
nza = a%ia2(nr+1) - 1
allocate(iaux(nza),stat=info)
if (info /=0) then
write(0,*) 'Failed allocation ',info, nza
return
allocate(iaux(max(nza,1)),stat=info)
if (info /= 0) then
info=4025
call psb_errpush(info,name,a_err='integer',i_err=(/max(nza,1),0,0,0,0/))
goto 9999
end if
!!$ write(0,*) 'ipcsr2coo ',a%m
call psb_transfer(a%ia2,itemp,info)
base/serial/psb_zipcoo2csc.f90
+6 -1
View File
@@ -74,7 +74,12 @@ subroutine psb_zipcoo2csc(a,info,clshr)
call psb_fixcoo(a,info,idir=1)
nc = a%k
nza = a%infoa(psb_nnz_)
allocate(iaux(nc+1))
allocate(iaux(max(nc+1,1)),stat=info)
if (info /= 0) then
info=4025
call psb_errpush(info,name,a_err='integer',i_err=(/max(nc+1,1),0,0,0,0/))
goto 9999
end if
if(debug) write(0,*)'DIPCOO2CSC: out of fixcoo',nza,nc,size(a%ia2),size(iaux)
call psb_transfer(a%ia2,itemp,info)
base/serial/psb_zipcoo2csr.f90
+3 -2
View File
@@ -74,9 +74,10 @@ subroutine psb_zipcoo2csr(a,info,rwshr)
call psb_fixcoo(a,info)
nr = a%m
nza = a%infoa(psb_nnz_)
allocate(iaux(nr+1),stat=info)
allocate(iaux(max(nr+1,1)),stat=info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate')
info=4025
call psb_errpush(info,name,a_err='integer',i_err=(/max(nr+1,1),0,0,0,0/))
goto 9999
end if
base/serial/psb_zipcsr2coo.f90
+5 -4
View File
@@ -63,10 +63,11 @@ Subroutine psb_zipcsr2coo(a,info)
nr = a%m
nza = a%ia2(nr+1) - 1
allocate(iaux(nza),stat=info)
if (info /=0) then
write(0,*) 'Failed allocation ',info, nza
return
allocate(iaux(max(nza,1)),stat=info)
if (info /= 0) then
info=4025
call psb_errpush(info,name,a_err='integer',i_err=(/max(nza,1),0,0,0,0/))
goto 9999
end if
!!$ write(0,*) 'ipcsr2coo ',a%m
call psb_transfer(a%ia2,itemp,info)