mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-20 21:02:26 +00:00
Fixed various UMFPACK related issues.
This commit is contained in:
@@ -246,7 +246,7 @@ contains
|
||||
integer, intent(in) :: ip
|
||||
logical :: is_legal_ml_fact
|
||||
|
||||
is_legal_ml_fact = ((ip>=f_ilu_n_).and.(ip<=f_slu_))
|
||||
is_legal_ml_fact = ((ip>=f_ilu_n_).and.(ip<=f_umf_))
|
||||
return
|
||||
end function is_legal_ml_fact
|
||||
function is_legal_ml_lev(ip)
|
||||
|
||||
@@ -627,7 +627,7 @@ subroutine psb_umf_bld(a,desc_a,p,info)
|
||||
endif
|
||||
|
||||
call fort_umf_factor(atmp%m,nzt,&
|
||||
& atmp%aspk,atmp%ia2,atmp%ia1,&
|
||||
& atmp%aspk,atmp%ia1,atmp%ia2,&
|
||||
& p%iprcparm(umf_symptr_),p%iprcparm(umf_numptr_),info)
|
||||
if(info /= 0) then
|
||||
info=4010
|
||||
@@ -811,6 +811,36 @@ subroutine psb_mlprec_bld(a,desc_a,p,info)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
case(f_umf_)
|
||||
call psb_spall(0,0,p%av(l_pr_),1,info)
|
||||
call psb_spall(0,0,p%av(u_pr_),1,info)
|
||||
call psb_ipcsr2coo(p%av(ac_),info)
|
||||
if(info /= 0) then
|
||||
info=4011
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
k=0
|
||||
do i=1,p%av(ac_)%infoa(psb_nnz_)
|
||||
if (p%av(ac_)%ia2(i) <= p%av(ac_)%m) then
|
||||
k = k + 1
|
||||
p%av(ac_)%aspk(k) = p%av(ac_)%aspk(i)
|
||||
p%av(ac_)%ia1(k) = p%av(ac_)%ia1(i)
|
||||
p%av(ac_)%ia2(k) = p%av(ac_)%ia2(i)
|
||||
end if
|
||||
end do
|
||||
p%av(ac_)%infoa(psb_nnz_) = k
|
||||
call psb_ipcoo2csc(p%av(ac_),info)
|
||||
call psb_spinfo(psb_nztotreq_,p%av(ac_),nzg,info)
|
||||
call fort_umf_factor(nrg,nzg,&
|
||||
& p%av(ac_)%aspk,p%av(ac_)%ia1,p%av(ac_)%ia2,&
|
||||
& p%iprcparm(umf_symptr_),p%iprcparm(umf_numptr_),info)
|
||||
if(info /= 0) then
|
||||
info=4011
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
case default
|
||||
write(0,*) 'Invalid fact type for multi level',(p%iprcparm(f_type_))
|
||||
end select
|
||||
|
||||
@@ -79,6 +79,7 @@ Subroutine psb_dfixcoo(A,INFO,idir)
|
||||
a%infoa(psb_srtd_) = psb_isrtdcoo_
|
||||
|
||||
if(debug) write(0,*)'FIXCOO: end second loop'
|
||||
|
||||
case(1) ! Col major order
|
||||
|
||||
call mrgsrt(nza,a%ia2,iaux,iret)
|
||||
|
||||
@@ -45,8 +45,7 @@ subroutine psb_dipcoo2csc(a,info,clshr)
|
||||
allocate(iaux(nc+1))
|
||||
if(debug) write(0,*)'DIPCOO2CSC: out of fixcoo',nza,nc,size(a%ia2),size(iaux)
|
||||
|
||||
itemp => a%ia1
|
||||
a%ia1 => a%ia2
|
||||
itemp => a%ia2
|
||||
a%ia2 => iaux
|
||||
|
||||
!
|
||||
@@ -120,19 +119,24 @@ subroutine psb_dipcoo2csc(a,info,clshr)
|
||||
j = j + 1
|
||||
if (j > nza) exit
|
||||
if (itemp(j) /= icl) then
|
||||
if (i>nc) then
|
||||
write(0,*) 'Strange situation in coo2csc: ',i,nc,size(a%ia2),&
|
||||
& nza,j,itemp(j)
|
||||
end if
|
||||
a%ia2(i+1) = j
|
||||
icl = itemp(j)
|
||||
i = i + 1
|
||||
endif
|
||||
if (i>nc) exit
|
||||
enddo outer
|
||||
!
|
||||
! Cleanup empty cols at the end
|
||||
!
|
||||
if (j /= (nza+1)) then
|
||||
write(0,*) 'IPCOO2CSC : Problem from loop :',j,nza
|
||||
write(0,*) 'IPCOO2CSC : Problem from loop :',j,nza,itemp(j)
|
||||
endif
|
||||
do
|
||||
if (i>=nc+1) exit
|
||||
if (i>nc) exit
|
||||
a%ia2(i+1) = j
|
||||
i = i + 1
|
||||
end do
|
||||
|
||||
@@ -124,6 +124,7 @@ subroutine psb_dipcoo2csr(a,info,rwshr)
|
||||
irw = itemp(j)
|
||||
i = i + 1
|
||||
endif
|
||||
if (i>nr) exit
|
||||
enddo outer
|
||||
!
|
||||
! Cleanup empty rows at the end
|
||||
@@ -132,7 +133,7 @@ subroutine psb_dipcoo2csr(a,info,rwshr)
|
||||
write(0,*) 'IPCOO2CSR : Problem from loop :',j,nza
|
||||
endif
|
||||
do
|
||||
if (i>=nr+1) exit
|
||||
if (i>nr) exit
|
||||
a%ia2(i+1) = j
|
||||
i = i + 1
|
||||
end do
|
||||
|
||||
@@ -20,7 +20,7 @@ subroutine psb_dspinfo(ireq,a,ires,info,iaux)
|
||||
integer, intent(out) :: ires, info
|
||||
integer, intent(in), optional :: iaux
|
||||
|
||||
integer :: i,j,k,ip,jp,nr,irw,nz, err_act, row, ipx, pia, pja, rb,idx
|
||||
integer :: i,j,k,ip,jp,nr,irw,nz, err_act, row, ipx, pia, pja, rb,idx, nc
|
||||
integer, pointer :: ia1(:), ia2(:), ia3(:), ja(:)
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
@@ -38,7 +38,10 @@ subroutine psb_dspinfo(ireq,a,ires,info,iaux)
|
||||
ires = a%infoa(psb_nnz_)
|
||||
else if (a%fida == 'JAD') then
|
||||
ires = a%infoa(psb_nnz_)
|
||||
else
|
||||
else if (a%fida == 'CSC') then
|
||||
nc = a%k
|
||||
ires = a%ia2(nc+1)-1
|
||||
else
|
||||
ires=-1
|
||||
info=136
|
||||
ch_err=a%fida(1:3)
|
||||
|
||||
Reference in New Issue
Block a user