diff --git a/base/serial/psb_dipcoo2csc.f90 b/base/serial/psb_dipcoo2csc.f90 index 674471ad..34e96f43 100644 --- a/base/serial/psb_dipcoo2csc.f90 +++ b/base/serial/psb_dipcoo2csc.f90 @@ -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) diff --git a/base/serial/psb_dipcoo2csr.f90 b/base/serial/psb_dipcoo2csr.f90 index c765dd9c..50fbea8e 100644 --- a/base/serial/psb_dipcoo2csr.f90 +++ b/base/serial/psb_dipcoo2csr.f90 @@ -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 diff --git a/base/serial/psb_dipcsr2coo.f90 b/base/serial/psb_dipcsr2coo.f90 index 0bb8b6dd..c71571ce 100644 --- a/base/serial/psb_dipcsr2coo.f90 +++ b/base/serial/psb_dipcsr2coo.f90 @@ -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) diff --git a/base/serial/psb_zipcoo2csc.f90 b/base/serial/psb_zipcoo2csc.f90 index bdac4847..05cd9a43 100644 --- a/base/serial/psb_zipcoo2csc.f90 +++ b/base/serial/psb_zipcoo2csc.f90 @@ -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) diff --git a/base/serial/psb_zipcoo2csr.f90 b/base/serial/psb_zipcoo2csr.f90 index f325911f..bc0e7888 100644 --- a/base/serial/psb_zipcoo2csr.f90 +++ b/base/serial/psb_zipcoo2csr.f90 @@ -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 diff --git a/base/serial/psb_zipcsr2coo.f90 b/base/serial/psb_zipcsr2coo.f90 index a0fe0e3d..32d4a6af 100644 --- a/base/serial/psb_zipcsr2coo.f90 +++ b/base/serial/psb_zipcsr2coo.f90 @@ -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)