fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-21 05:12:13 +00:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
multilevel preconditioners.
This commit is contained in:
Salvatore Filippone
2006-04-18 13:37:02 +00:00
parent c0526dd9d2
commit 8ca0d6fa93
14 changed files with 166 additions and 101 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/serial/dp/dcoco.f
+1 -1
View File
@@ -78,7 +78,7 @@ c
p1(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
write(*,*) 'on entry to dcoco: nnz laux ',
+ nnz,laux,larn,lia1n,lia2n
src/serial/dp/dcrco.f
+1 -1
View File
@@ -101,7 +101,7 @@ C ... Construct COO Representation...
ELEM = ELEM + 1
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
DO 20 K = 1, M
src/serial/dp/zcoco.f
+1 -1
View File
@@ -77,7 +77,7 @@ c
p1(1) = 0
p2(1) = 0
nnz = info(psb_nnz_)
call psb_getifield(nnz,psb_nnz_,info,psb_ifasize_,ierror)
if (debug) then
write(*,*) 'on entry to dcoco: nnz laux ',
+ nnz,laux,larn,lia1n,lia2n
src/serial/dp/zcrco.f
+1 -1
View File
@@ -101,7 +101,7 @@ C ... Construct COO Representation...
ELEM = ELEM + 1
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
DO 20 K = 1, M
src/serial/psb_dcsdp.f90
+14 -7
View File
@@ -150,8 +150,6 @@ subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
end if
if (check_/='R') then
if (present(upd)) then
@@ -289,7 +287,11 @@ subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
call psb_errpush(4010,name,a_err='dcrco')
goto 9999
end if
case default
info=4010
call psb_errpush(info,name)
goto 9999
end select
case ('COO','COI')
@@ -376,17 +378,22 @@ subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
goto 9999
end if
case default
info=4010
call psb_errpush(info,name)
goto 9999
end select
case default
info=4010
call psb_errpush(info,name)
goto 9999
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
!!$ write(0,*) 'Going for trimsize',size(b%ia1),size(b%ia2),size(b%aspk)
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)
!!$ write(0,*) 'From realloc',size(b%ia1),size(b%ia2),size(b%aspk)
endif
else if (check_=='R') then
src/serial/psb_dcsprt.f90
+44 -4
View File
@@ -77,7 +77,9 @@ subroutine psb_dcsprt(iout,a,iv,eirs,eics,head,ivr,ivc)
write(iout,'(a)') '%'
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
@@ -115,7 +117,45 @@ subroutine psb_dcsprt(iout,a,iv,eirs,eics,head,ivr,ivc)
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
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)
enddo
endif
else
case default
write(0,*) 'Feeling lazy today, format not implemented: "',a%fida,'"'
endif
end select
end subroutine psb_dcsprt
src/serial/psb_dipcoo2csc.f90
-1
View File
@@ -101,7 +101,6 @@ subroutine psb_dipcoo2csc(a,info,clshr)
if (clshr_) then
j = 1
i = 1
icl = itemp(j)
src/serial/psb_zcsdp.f90
+15 -8
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,&
& ia1_size, ia2_size, aspk_size, upd_,info)
!!$ write(0,*) 'ESTIMATE : ',ia1_size,ia2_size,aspk_Size,upd_
if (info /= no_err) then
info=4010
ch_err='psb_cest'
@@ -289,7 +288,11 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
call psb_errpush(4010,name,a_err='dcrco')
goto 9999
end if
case default
info=4010
call psb_errpush(info,name)
goto 9999
end select
case ('COO','COI')
@@ -365,8 +368,6 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
end do
case ('COO')
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
end if
case default
info=4010
call psb_errpush(info,name)
goto 9999
end select
case default
info=4010
call psb_errpush(info,name)
goto 9999
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
!!$ write(0,*) 'Going for trimsize',size(b%ia1),size(b%ia2),size(b%aspk)
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)
!!$ write(0,*) 'From realloc',size(b%ia1),size(b%ia2),size(b%aspk)
endif
else if (check_=='R') then
!...Regenerating matrix
if (psb_sp_getifld(psb_state_,b,info) /= psb_spmat_upd_) then
info = 8888
call psb_errpush(info,name)