diff --git a/src/modules/psb_prec_type.f90 b/src/modules/psb_prec_type.f90 index ac92ff7e..59e8c4c9 100644 --- a/src/modules/psb_prec_type.f90 +++ b/src/modules/psb_prec_type.f90 @@ -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) diff --git a/src/prec/psb_dprecbld.f90 b/src/prec/psb_dprecbld.f90 index 4f3a9e35..9235df7d 100644 --- a/src/prec/psb_dprecbld.f90 +++ b/src/prec/psb_dprecbld.f90 @@ -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 diff --git a/src/serial/psb_dfixcoo.f90 b/src/serial/psb_dfixcoo.f90 index 1b14816e..20497fe8 100644 --- a/src/serial/psb_dfixcoo.f90 +++ b/src/serial/psb_dfixcoo.f90 @@ -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) diff --git a/src/serial/psb_dipcoo2csc.f90 b/src/serial/psb_dipcoo2csc.f90 index 0a05dd55..3f2a10a0 100644 --- a/src/serial/psb_dipcoo2csc.f90 +++ b/src/serial/psb_dipcoo2csc.f90 @@ -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 diff --git a/src/serial/psb_dipcoo2csr.f90 b/src/serial/psb_dipcoo2csr.f90 index 964fa355..421f6f66 100644 --- a/src/serial/psb_dipcoo2csr.f90 +++ b/src/serial/psb_dipcoo2csr.f90 @@ -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 diff --git a/src/serial/psb_dspinfo.f90 b/src/serial/psb_dspinfo.f90 index b93a853f..7bfa031b 100644 --- a/src/serial/psb_dspinfo.f90 +++ b/src/serial/psb_dspinfo.f90 @@ -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)