psblas2-dev/base:

modules/psb_spmat_type.f90
 serial/psb_dipcoo2csc.f90
 serial/psb_zipcoo2csc.f90

Fixed handling of trim for CSC (needed for UMFPACK).
psblas3-type-indexed
Salvatore Filippone 17 years ago
parent 05983fc8c2
commit afe8e6bdbc

@ -751,6 +751,11 @@ contains
ia = nza ia = nza
i1 = nza i1 = nza
i2 = a%m + 1 i2 = a%m + 1
case('csc')
nza = a%ia2(a%k+1)-1
ia = nza
i1 = nza
i2 = a%k + 1
case('coo','coi') case('coo','coi')
nza = a%infoa(psb_nnz_) nza = a%infoa(psb_nnz_)
i1 = nza i1 = nza
@ -1238,6 +1243,11 @@ contains
ia = nza ia = nza
i1 = nza i1 = nza
i2 = a%m + 1 i2 = a%m + 1
case('csc')
nza = a%ia2(a%k+1)-1
ia = nza
i1 = nza
i2 = a%k + 1
case('coo','coi') case('coo','coi')
nza = a%infoa(psb_nnz_) nza = a%infoa(psb_nnz_)
i1 = nza i1 = nza

@ -76,9 +76,11 @@ subroutine psb_dipcoo2csc(a,info,clshr)
end if end if
call psb_fixcoo(a,info,idir=1) call psb_fixcoo(a,info,idir=1)
if (info == 0) then
nc = a%k nc = a%k
nza = a%infoa(psb_nnz_) nza = a%infoa(psb_nnz_)
allocate(iaux(max(nc+1,1)),stat=info) allocate(iaux(max(nc+1,1)),stat=info)
end if
if (info /= 0) then if (info /= 0) then
info=4025 info=4025
call psb_errpush(info,name,a_err='integer',i_err=(/max(nc+1,1),0,0,0,0/)) call psb_errpush(info,name,a_err='integer',i_err=(/max(nc+1,1),0,0,0,0/))
@ -88,7 +90,12 @@ subroutine psb_dipcoo2csc(a,info,clshr)
& ': out of fixcoo',nza,nc,size(a%ia2),size(iaux) & ': out of fixcoo',nza,nc,size(a%ia2),size(iaux)
call psb_transfer(a%ia2,itemp,info) call psb_transfer(a%ia2,itemp,info)
call psb_transfer(iaux,a%ia2,info) if (info == 0) call psb_transfer(iaux,a%ia2,info)
if (info /= 0) then
info=4010
call psb_errpush(info,name,a_err='psb_transfer')
goto 9999
end if
! !
! This routine can be used in two modes: ! This routine can be used in two modes:

@ -76,9 +76,11 @@ subroutine psb_zipcoo2csc(a,info,clshr)
end if end if
call psb_fixcoo(a,info,idir=1) call psb_fixcoo(a,info,idir=1)
if (info == 0) then
nc = a%k nc = a%k
nza = a%infoa(psb_nnz_) nza = a%infoa(psb_nnz_)
allocate(iaux(max(nc+1,1)),stat=info) allocate(iaux(max(nc+1,1)),stat=info)
end if
if (info /= 0) then if (info /= 0) then
info=4025 info=4025
call psb_errpush(info,name,a_err='integer',i_err=(/max(nc+1,1),0,0,0,0/)) call psb_errpush(info,name,a_err='integer',i_err=(/max(nc+1,1),0,0,0,0/))
@ -88,7 +90,12 @@ subroutine psb_zipcoo2csc(a,info,clshr)
& ': out of fixcoo',nza,nc,size(a%ia2),size(iaux) & ': out of fixcoo',nza,nc,size(a%ia2),size(iaux)
call psb_transfer(a%ia2,itemp,info) call psb_transfer(a%ia2,itemp,info)
call psb_transfer(iaux,a%ia2,info) if (info == 0) call psb_transfer(iaux,a%ia2,info)
if (info /= 0) then
info=4010
call psb_errpush(info,name,a_err='psb_transfer')
goto 9999
end if
! !
! This routine can be used in two modes: ! This routine can be used in two modes:

Loading…
Cancel
Save