fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Fixed bugs in matrix conversions, showing up in dense factors for

Browse Source 
multilevel preconditioners.
psblas3-type-indexed
Salvatore Filippone 19 years ago
parent c0526dd9d2
commit 8ca0d6fa93
14 changed files with 167 additions and 102 deletions
Show Stats Download Patch File Download Diff File

7
src/prec/psb_dbaseprc_bld.f90
Unescape Escape View File

@ -86,7 +86,7 @@ subroutine psb_dbaseprc_bld(a,desc_a,p,info,upd)
use psb_const_mod use psb_const_mod
implicit none implicit none
type(psb_dspmat_type), intent(in) :: a type(psb_dspmat_type), intent(inout) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_dbaseprc_type), intent(inout) :: p type(psb_dbaseprc_type), intent(inout) :: p
integer, intent(out) :: info integer, intent(out) :: info
@ -101,7 +101,7 @@ subroutine psb_dbaseprc_bld(a,desc_a,p,info,upd)
use psb_const_mod use psb_const_mod
implicit none implicit none
type(psb_dspmat_type), intent(in) :: a type(psb_dspmat_type), intent(inout) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_dbaseprc_type), intent(inout) :: p type(psb_dbaseprc_type), intent(inout) :: p
integer, intent(out) :: info integer, intent(out) :: info
@ -194,13 +194,14 @@ subroutine psb_dbaseprc_bld(a,desc_a,p,info,upd)
& f_ilu_n_,is_legal_ml_fact) & f_ilu_n_,is_legal_ml_fact)
if (debug) write(0,*)me, ': Calling PSB_ILU_BLD' if (debug) write(0,*)me, ': Calling PSB_ILU_BLD'
if (debug) call blacs_barrier(icontxt,'All')
select case(p%iprcparm(f_type_)) select case(p%iprcparm(f_type_))
case(f_ilu_n_,f_ilu_e_) case(f_ilu_n_,f_ilu_e_)
call psb_ilu_bld(a,desc_a,p,iupd,info) call psb_ilu_bld(a,desc_a,p,iupd,info)
if(debug) write(0,*)me,': out of psb_ilu_bld' if(debug) write(0,*)me,': out of psb_ilu_bld'
if (debug) call blacs_barrier(icontxt,'All')
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
ch_err='psb_ilu_bld' ch_err='psb_ilu_bld'

10
src/prec/psb_dilu_bld.f90
Unescape Escape View File

@ -160,6 +160,7 @@ subroutine psb_dilu_bld(a,desc_a,p,upd,info)
t1= mpi_wtime() t1= mpi_wtime()
if(debug) write(0,*)me,': calling psb_asmatbld',p%iprcparm(p_type_),p%iprcparm(n_ovr_) if(debug) write(0,*)me,': calling psb_asmatbld',p%iprcparm(p_type_),p%iprcparm(n_ovr_)
if (debug) call blacs_barrier(icontxt,'All')
call psb_asmatbld(p%iprcparm(p_type_),p%iprcparm(n_ovr_),a,& call psb_asmatbld(p%iprcparm(p_type_),p%iprcparm(n_ovr_),a,&
& blck,desc_a,upd,p%desc_data,info) & blck,desc_a,upd,p%desc_data,info)
if(info/=0) then if(info/=0) then
@ -169,7 +170,8 @@ subroutine psb_dilu_bld(a,desc_a,p,upd,info)
goto 9999 goto 9999
end if end if
t2= mpi_wtime() t2= mpi_wtime()
if(debug) write(0,*)me,': out of psb_asmatbld' if (debug) write(0,*)me,': out of psb_asmatbld'
if (debug) call blacs_barrier(icontxt,'All')
if (associated(p%av)) then if (associated(p%av)) then
if (size(p%av) < bp_ilu_avsz) then if (size(p%av) < bp_ilu_avsz) then
@ -189,6 +191,9 @@ subroutine psb_dilu_bld(a,desc_a,p,upd,info)
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
if (debug) write(0,*)me,': out spinfo',nztota
if (debug) call blacs_barrier(icontxt,'All')
n_col = desc_a%matrix_data(psb_n_col_) n_col = desc_a%matrix_data(psb_n_col_)
nhalo = n_col-nrow_a nhalo = n_col-nrow_a
n_row = p%desc_data%matrix_data(psb_n_row_) n_row = p%desc_data%matrix_data(psb_n_row_)
@ -198,7 +203,7 @@ subroutine psb_dilu_bld(a,desc_a,p,upd,info)
p%av(u_pr_)%m = n_row p%av(u_pr_)%m = n_row
p%av(u_pr_)%k = n_row p%av(u_pr_)%k = n_row
call psb_sp_all(n_row,n_row,p%av(l_pr_),nztota+lovr,info) call psb_sp_all(n_row,n_row,p%av(l_pr_),nztota+lovr,info)
call psb_sp_all(n_row,n_row,p%av(u_pr_),nztota+lovr,info) if (info == 0) call psb_sp_all(n_row,n_row,p%av(u_pr_),nztota+lovr,info)
if(info/=0) then if(info/=0) then
info=4010 info=4010
ch_err='psb_sp_all' ch_err='psb_sp_all'
@ -305,6 +310,7 @@ subroutine psb_dilu_bld(a,desc_a,p,upd,info)
t5= mpi_wtime() t5= mpi_wtime()
if (debug) write(0,*) me,' Going for dilu_fct' if (debug) write(0,*) me,' Going for dilu_fct'
if (debug) call blacs_barrier(icontxt,'All')
call psb_ilu_fct(a,p%av(l_pr_),p%av(u_pr_),p%d,info,blck=blck) call psb_ilu_fct(a,p%av(l_pr_),p%av(u_pr_),p%d,info,blck=blck)
if(info/=0) then if(info/=0) then
info=4010 info=4010

2
src/prec/psb_dslu_bld.f90
Unescape Escape View File

@ -41,7 +41,7 @@ subroutine psb_dslu_bld(a,desc_a,p,info)
use psb_const_mod use psb_const_mod
implicit none implicit none
type(psb_dspmat_type), intent(in) :: a type(psb_dspmat_type), intent(inout) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_dbaseprc_type), intent(inout) :: p type(psb_dbaseprc_type), intent(inout) :: p
integer, intent(out) :: info integer, intent(out) :: info

144
src/prec/psb_dumf_bld.f90
Unescape Escape View File

@ -42,7 +42,7 @@ subroutine psb_dumf_bld(a,desc_a,p,info)
use psb_const_mod use psb_const_mod
implicit none implicit none
type(psb_dspmat_type), intent(in) :: a type(psb_dspmat_type), intent(inout) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
type(psb_dbaseprc_type), intent(inout) :: p type(psb_dbaseprc_type), intent(inout) :: p
integer, intent(out) :: info integer, intent(out) :: info
@ -69,7 +69,7 @@ subroutine psb_dumf_bld(a,desc_a,p,info)
integer, intent(out) :: info integer, intent(out) :: info
character(len=5), optional :: outfmt character(len=5), optional :: outfmt
end Subroutine psb_dasmatbld end Subroutine psb_dasmatbld
end interface end interface
info=0 info=0
name='psb_umf_bld' name='psb_umf_bld'
@ -84,118 +84,122 @@ subroutine psb_dumf_bld(a,desc_a,p,info)
call psb_nullify_sp(atmp) call psb_nullify_sp(atmp)
atmp%fida='COO' atmp%fida='COO'
if (Debug) then if (Debug) then
write(0,*) me, 'UMFBLD: Calling csdp' write(0,*) me, 'UMFBLD: Calling csdp'
call blacs_barrier(icontxt,'All') call blacs_barrier(icontxt,'All')
endif endif
call psb_dcsdp(a,atmp,info) call psb_dcsdp(a,atmp,info)
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
ch_err='psb_dcsdp' ch_err='psb_dcsdp'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
call psb_spinfo(psb_nztotreq_,atmp,nza,info) call psb_spinfo(psb_nztotreq_,atmp,nza,info)
if (Debug) then if (Debug) then
write(0,*) me, 'UMFBLD: Done csdp',info,nza,atmp%m,atmp%k call psb_spinfo(psb_nztotreq_,a,nzb,info)
call blacs_barrier(icontxt,'All') write(0,*) me, 'UMFBLD: Done csdp',info,nza,atmp%m,atmp%k,nzb
call blacs_barrier(icontxt,'All')
endif endif
call psb_asmatbld(p%iprcparm(p_type_),p%iprcparm(n_ovr_),a,& call psb_asmatbld(p%iprcparm(p_type_),p%iprcparm(n_ovr_),a,&
& blck,desc_a,upd,p%desc_data,info,outfmt=fmt) & blck,desc_a,upd,p%desc_data,info,outfmt=fmt)
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
ch_err='psb_asmatbld' ch_err='psb_asmatbld'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
call psb_spinfo(psb_nztotreq_,blck,nzb,info) call psb_spinfo(psb_nztotreq_,blck,nzb,info)
if (Debug) then if (Debug) then
write(0,*) me, 'UMFBLD: Done asmatbld',info,nzb,blck%fida write(0,*) me, 'UMFBLD: Done asmatbld',info,nzb,blck%fida
call blacs_barrier(icontxt,'All') call blacs_barrier(icontxt,'All')
endif endif
if (nzb > 0 ) then if (nzb > 0 ) then
if (size(atmp%aspk)<nza+nzb) then if (size(atmp%aspk)<nza+nzb) then
call psb_sp_reall(atmp,nza+nzb,info) call psb_sp_reall(atmp,nza+nzb,info)
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
ch_err='psb_sp_reall' ch_err='psb_sp_reall'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
endif endif
if (Debug) then if (Debug) then
write(0,*) me, 'UMFBLD: Done realloc',info,nza+nzb,atmp%fida write(0,*) me, 'UMFBLD: Done realloc',info,nza+nzb,atmp%fida
call blacs_barrier(icontxt,'All') call blacs_barrier(icontxt,'All')
endif endif
do j=1,nzb do j=1,nzb
atmp%aspk(nza+j) = blck%aspk(j) atmp%aspk(nza+j) = blck%aspk(j)
atmp%ia1(nza+j) = blck%ia1(j) atmp%ia1(nza+j) = blck%ia1(j)
atmp%ia2(nza+j) = blck%ia2(j) atmp%ia2(nza+j) = blck%ia2(j)
end do end do
atmp%infoa(psb_nnz_) = nza+nzb atmp%infoa(psb_nnz_) = nza+nzb
atmp%m = atmp%m + blck%m atmp%m = atmp%m + blck%m
atmp%k = max(a%k,blck%k) atmp%k = max(a%k,blck%k)
else else
atmp%infoa(psb_nnz_) = nza atmp%infoa(psb_nnz_) = nza
atmp%m = a%m atmp%m = a%m
atmp%k = a%k atmp%k = a%k
endif endif
i=0 i=0
do j=1, atmp%infoa(psb_nnz_) do j=1, atmp%infoa(psb_nnz_)
if (atmp%ia2(j) <= atmp%m) then if (atmp%ia2(j) <= atmp%m) then
i = i + 1 i = i + 1
atmp%aspk(i) = atmp%aspk(j) atmp%aspk(i) = atmp%aspk(j)
atmp%ia1(i) = atmp%ia1(j) atmp%ia1(i) = atmp%ia1(j)
atmp%ia2(i) = atmp%ia2(j) atmp%ia2(i) = atmp%ia2(j)
endif endif
enddo enddo
atmp%infoa(psb_nnz_) = i atmp%infoa(psb_nnz_) = i
call psb_ipcoo2csc(atmp,info) call psb_ipcoo2csc(atmp,info)
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
ch_err='psb_ipcoo2csc' ch_err='psb_ipcoo2csc'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
call psb_spinfo(psb_nztotreq_,atmp,nzt,info) call psb_spinfo(psb_nztotreq_,atmp,nzt,info)
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
ch_err='psb_spinfo' ch_err='psb_spinfo'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
if (Debug) then if (Debug) then
write(0,*) me,'Calling psb_umf_factor ',nzt,atmp%m,& write(0,*) me,'Calling psb_umf_factor ',nzt,atmp%m,&
& atmp%k,p%desc_data%matrix_data(psb_n_row_) & atmp%k,p%desc_data%matrix_data(psb_n_row_)
call blacs_barrier(icontxt,'All') open(80+me)
call psb_csprt(80+me,atmp)
close(80+me)
call blacs_barrier(icontxt,'All')
endif endif
call psb_dumf_factor(atmp%m,nzt,& call psb_dumf_factor(atmp%m,nzt,&
& atmp%aspk,atmp%ia1,atmp%ia2,& & atmp%aspk,atmp%ia1,atmp%ia2,&
& p%iprcparm(umf_symptr_),p%iprcparm(umf_numptr_),info) & p%iprcparm(umf_symptr_),p%iprcparm(umf_numptr_),info)
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
ch_err='psb_umf_fact' ch_err='psb_umf_fact'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
if (Debug) then if (Debug) then
write(0,*) me, 'UMFBLD: Done umf_Factor',info,p%iprcparm(umf_numptr_) write(0,*) me, 'UMFBLD: Done umf_Factor',info,p%iprcparm(umf_numptr_)
call blacs_barrier(icontxt,'All') call blacs_barrier(icontxt,'All')
endif endif
call psb_sp_free(blck,info) call psb_sp_free(blck,info)
call psb_sp_free(atmp,info) call psb_sp_free(atmp,info)
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
ch_err='psb_sp_free' ch_err='psb_sp_free'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
@ -204,8 +208,8 @@ subroutine psb_dumf_bld(a,desc_a,p,info)
9999 continue 9999 continue
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then if (err_act.eq.act_abort) then
call psb_error() call psb_error()
return return
end if end if
return return

3
src/prec/psb_umf_impl.c
Unescape Escape View File

@ -141,11 +141,12 @@ psb_dumf_factor_(int *n, int *nnz,
if ( *info == UMFPACK_OK ) { if ( *info == UMFPACK_OK ) {
*info = 0; *info = 0;
*numptr = (fptr) Numeric;
} else { } else {
printf("umfpack_di_numeric() error returns INFO= %d\n", *info); printf("umfpack_di_numeric() error returns INFO= %d\n", *info);
*numptr = (fptr) NULL;
} }
*numptr = (fptr) Numeric;
for (i = 0; i <= *n; ++i) ++colptr[i]; for (i = 0; i <= *n; ++i) ++colptr[i];
for (i = 0; i < *nnz; ++i) ++rowind[i]; for (i = 0; i < *nnz; ++i) ++rowind[i];
#else #else

2
src/serial/dp/dcoco.f
Unescape Escape View File

@ -78,7 +78,7 @@ c
p1(1) = 0 p1(1) = 0
p2(1) = 0 p2(1) = 0
call psb_getifield(nnz,psb_nnz_,infon,psb_ifasize_,ierror) call psb_getifield(nnz,psb_nnz_,info,psb_ifasize_,ierror)
if (debug) then if (debug) then
write(*,*) 'on entry to dcoco: nnz laux ', write(*,*) 'on entry to dcoco: nnz laux ',
+ nnz,laux,larn,lia1n,lia2n + nnz,laux,larn,lia1n,lia2n

2
src/serial/dp/dcrco.f
Unescape Escape View File

@ -101,7 +101,7 @@ C ... Construct COO Representation...
ELEM = ELEM + 1 ELEM = ELEM + 1
ENDDO ENDDO
ENDDO ENDDO
INFON(1) = IA2(M+1)-1 INFON(psb_nnz_) = IA2(M+1)-1
ELSE IF (DESCRA(1:1).EQ.'S' .AND. DESCRA(2:2).EQ.'U') THEN ELSE IF (DESCRA(1:1).EQ.'S' .AND. DESCRA(2:2).EQ.'U') THEN
DO 20 K = 1, M DO 20 K = 1, M

2
src/serial/dp/zcoco.f
Unescape Escape View File

@ -77,7 +77,7 @@ c
p1(1) = 0 p1(1) = 0
p2(1) = 0 p2(1) = 0
nnz = info(psb_nnz_) call psb_getifield(nnz,psb_nnz_,info,psb_ifasize_,ierror)
if (debug) then if (debug) then
write(*,*) 'on entry to dcoco: nnz laux ', write(*,*) 'on entry to dcoco: nnz laux ',
+ nnz,laux,larn,lia1n,lia2n + nnz,laux,larn,lia1n,lia2n

2
src/serial/dp/zcrco.f
Unescape Escape View File

@ -101,7 +101,7 @@ C ... Construct COO Representation...
ELEM = ELEM + 1 ELEM = ELEM + 1
ENDDO ENDDO
ENDDO ENDDO
INFON(1) = IA2(M+1)-1 INFON(psb_nnz_) = IA2(M+1)-1
ELSE IF (DESCRA(1:1).EQ.'S' .AND. DESCRA(2:2).EQ.'U') THEN ELSE IF (DESCRA(1:1).EQ.'S' .AND. DESCRA(2:2).EQ.'U') THEN
DO 20 K = 1, M DO 20 K = 1, M

19
src/serial/psb_dcsdp.f90
Unescape Escape View File

@ -150,8 +150,6 @@ subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
end if end if
if (check_/='R') then if (check_/='R') then
if (present(upd)) then if (present(upd)) then
@ -289,6 +287,10 @@ subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
call psb_errpush(4010,name,a_err='dcrco') call psb_errpush(4010,name,a_err='dcrco')
goto 9999 goto 9999
end if end if
case default
info=4010
call psb_errpush(info,name)
goto 9999
end select end select
@ -376,17 +378,22 @@ subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
goto 9999 goto 9999
end if end if
case default
info=4010
call psb_errpush(info,name)
goto 9999
end select end select
case default
info=4010
call psb_errpush(info,name)
goto 9999
end select end select
!!$ write(0,*) 'End of assembly', psb_sp_getifld(psb_upd_,b,info) ,psb_upd_perm_
if (psb_sp_getifld(psb_upd_,b,info) /= psb_upd_perm_) then if (psb_sp_getifld(psb_upd_,b,info) /= psb_upd_perm_) then
!!$ write(0,*) 'Going for trimsize',size(b%ia1),size(b%ia2),size(b%aspk)
call psb_sp_trimsize(b,i1,i2,ia,info) call psb_sp_trimsize(b,i1,i2,ia,info)
!!$ write(0,*) 'From trimsize',i1,i2,ia,info
if (info == 0) call psb_sp_reall(b,i1,i2,ia,info) if (info == 0) call psb_sp_reall(b,i1,i2,ia,info)
!!$ write(0,*) 'From realloc',size(b%ia1),size(b%ia2),size(b%aspk)
endif endif
else if (check_=='R') then else if (check_=='R') then

48
src/serial/psb_dcsprt.f90
Unescape Escape View File

@ -77,7 +77,9 @@ subroutine psb_dcsprt(iout,a,iv,eirs,eics,head,ivr,ivc)
write(iout,'(a)') '%' write(iout,'(a)') '%'
endif endif
if (toupper(a%fida)=='CSR') then select case(toupper(a%fida))
case ('CSR')
write(iout,*) a%m,a%k,a%ia2(a%m+1)-1 write(iout,*) a%m,a%k,a%ia2(a%m+1)-1
@ -115,7 +117,45 @@ subroutine psb_dcsprt(iout,a,iv,eirs,eics,head,ivr,ivc)
endif endif
endif endif
else if (toupper(a%fida)=='COO') then case ('CSC')
write(iout,*) a%m,a%k,a%ia2(a%k+1)-1
if (present(iv)) then
do i=1, a%k
do j=a%ia2(i),a%ia2(i+1)-1
write(iout,frmtr) iv(irs+a%ia1(j)),iv(ics+i),a%aspk(j)
enddo
enddo
else
if (present(ivr).and..not.present(ivc)) then
do i=1, a%k
do j=a%ia2(i),a%ia2(i+1)-1
write(iout,frmtr) ivr(irs+a%ia1(j)),(ics+i),a%aspk(j)
enddo
enddo
else if (present(ivr).and.present(ivc)) then
do i=1, a%k
do j=a%ia2(i),a%ia2(i+1)-1
write(iout,frmtr) ivr(irs+a%ia1(j)),ivc(ics+i),a%aspk(j)
enddo
enddo
else if (.not.present(ivr).and.present(ivc)) then
do i=1, a%m
do j=a%ia2(i),a%ia2(i+1)-1
write(iout,frmtr) (irs+a%ia1(j)),ivc(ics+i),a%aspk(j)
enddo
enddo
else if (.not.present(ivr).and..not.present(ivc)) then
do i=1, a%k
do j=a%ia2(i),a%ia2(i+1)-1
write(iout,frmtr) (irs+a%ia1(j)),(ics+i),a%aspk(j)
enddo
enddo
endif
endif
case ('COO')
if (present(ivr).and..not.present(ivc)) then if (present(ivr).and..not.present(ivc)) then
write(iout,*) a%m,a%k,a%infoa(psb_nnz_) write(iout,*) a%m,a%k,a%infoa(psb_nnz_)
@ -138,7 +178,7 @@ subroutine psb_dcsprt(iout,a,iv,eirs,eics,head,ivr,ivc)
write(iout,frmtr) a%ia1(j),a%ia2(j),a%aspk(j) write(iout,frmtr) a%ia1(j),a%ia2(j),a%aspk(j)
enddo enddo
endif endif
else case default
write(0,*) 'Feeling lazy today, format not implemented: "',a%fida,'"' write(0,*) 'Feeling lazy today, format not implemented: "',a%fida,'"'
endif end select
end subroutine psb_dcsprt end subroutine psb_dcsprt

1
src/serial/psb_dipcoo2csc.f90
Unescape Escape View File

@ -101,7 +101,6 @@ subroutine psb_dipcoo2csc(a,info,clshr)
if (clshr_) then if (clshr_) then
j = 1 j = 1
i = 1 i = 1
icl = itemp(j) icl = itemp(j)

21
src/serial/psb_zcsdp.f90
Unescape Escape View File

@ -189,7 +189,6 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
call psb_cest(b%fida, n_row,n_col,size_req,& call psb_cest(b%fida, n_row,n_col,size_req,&
& ia1_size, ia2_size, aspk_size, upd_,info) & ia1_size, ia2_size, aspk_size, upd_,info)
!!$ write(0,*) 'ESTIMATE : ',ia1_size,ia2_size,aspk_Size,upd_
if (info /= no_err) then if (info /= no_err) then
info=4010 info=4010
ch_err='psb_cest' ch_err='psb_cest'
@ -289,6 +288,10 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
call psb_errpush(4010,name,a_err='dcrco') call psb_errpush(4010,name,a_err='dcrco')
goto 9999 goto 9999
end if end if
case default
info=4010
call psb_errpush(info,name)
goto 9999
end select end select
@ -365,8 +368,6 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
end do end do
case ('COO') case ('COO')
call zcoco(trans_, a%m, a%k, unitd_, d, a%descra, a%aspk,& call zcoco(trans_, a%m, a%k, unitd_, d, a%descra, a%aspk,&
@ -378,21 +379,27 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
goto 9999 goto 9999
end if end if
case default
info=4010
call psb_errpush(info,name)
goto 9999
end select end select
case default
info=4010
call psb_errpush(info,name)
goto 9999
end select end select
!!$ write(0,*) 'End of assembly', psb_sp_getifld(psb_upd_,b,info) ,psb_upd_perm_
if (psb_sp_getifld(psb_upd_,b,info) /= psb_upd_perm_) then if (psb_sp_getifld(psb_upd_,b,info) /= psb_upd_perm_) then
!!$ write(0,*) 'Going for trimsize',size(b%ia1),size(b%ia2),size(b%aspk)
call psb_sp_trimsize(b,i1,i2,ia,info) call psb_sp_trimsize(b,i1,i2,ia,info)
!!$ write(0,*) 'From trimsize',i1,i2,ia,info
if (info == 0) call psb_sp_reall(b,i1,i2,ia,info) if (info == 0) call psb_sp_reall(b,i1,i2,ia,info)
!!$ write(0,*) 'From realloc',size(b%ia1),size(b%ia2),size(b%aspk)
endif endif
else if (check_=='R') then else if (check_=='R') then
!...Regenerating matrix !...Regenerating matrix
if (psb_sp_getifld(psb_state_,b,info) /= psb_spmat_upd_) then if (psb_sp_getifld(psb_state_,b,info) /= psb_spmat_upd_) then
info = 8888 info = 8888
call psb_errpush(info,name) call psb_errpush(info,name)

Write Preview
Loading…
Cancel
Save