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

psblas3:

Browse Source 
base/serial/impl/psb_c_csc_impl.f90
 base/serial/impl/psb_d_csc_impl.f90
 base/serial/impl/psb_s_csc_impl.f90
 base/serial/impl/psb_z_csc_impl.f90
 opt/psb_d_rsb_mat_mod.F90
 prec/psb_d_diagprec.f90
 test/pargen/runs/ppde.inp

Fixed silly bug in csc_print.
psblas3-type-indexed
Salvatore Filippone 14 years ago
parent 3440db4404
commit 9f8f5bdd70
7 changed files with 69 additions and 68 deletions
Show Stats Download Patch File Download Diff File

10
base/serial/impl/psb_c_csc_impl.f90
Unescape Escape View File

@ -2924,32 +2924,32 @@ subroutine psb_c_csc_print(iout,a,iv,eirs,eics,head,ivr,ivc)
write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))'
write(iout,*) nr, nc, nz write(iout,*) nr, nc, nz
if(present(iv)) then if(present(iv)) then
do i=1, nr do i=1, nc
do j=a%icp(i),a%icp(i+1)-1 do j=a%icp(i),a%icp(i+1)-1
write(iout,frmtv) iv(a%ia(j)),iv(i),a%val(j) write(iout,frmtv) iv(a%ia(j)),iv(i),a%val(j)
end do end do
enddo enddo
else else
if (present(ivr).and..not.present(ivc)) then if (present(ivr).and..not.present(ivc)) then
do i=1, nr do i=1, nc
do j=a%icp(i),a%icp(i+1)-1 do j=a%icp(i),a%icp(i+1)-1
write(iout,frmtv) ivr(a%ia(j)),i,a%val(j) write(iout,frmtv) ivr(a%ia(j)),i,a%val(j)
end do end do
enddo enddo
else if (present(ivr).and.present(ivc)) then else if (present(ivr).and.present(ivc)) then
do i=1, nr do i=1, nc
do j=a%icp(i),a%icp(i+1)-1 do j=a%icp(i),a%icp(i+1)-1
write(iout,frmtv) ivr(a%ia(j)),ivc(i),a%val(j) write(iout,frmtv) ivr(a%ia(j)),ivc(i),a%val(j)
end do end do
enddo enddo
else if (.not.present(ivr).and.present(ivc)) then else if (.not.present(ivr).and.present(ivc)) then
do i=1, nr do i=1, nc
do j=a%icp(i),a%icp(i+1)-1 do j=a%icp(i),a%icp(i+1)-1
write(iout,frmtv) (a%ia(j)),ivc(i),a%val(j) write(iout,frmtv) (a%ia(j)),ivc(i),a%val(j)
end do end do
enddo enddo
else if (.not.present(ivr).and..not.present(ivc)) then else if (.not.present(ivr).and..not.present(ivc)) then
do i=1, nr do i=1, nc
do j=a%icp(i),a%icp(i+1)-1 do j=a%icp(i),a%icp(i+1)-1
write(iout,frmtv) (a%ia(j)),(i),a%val(j) write(iout,frmtv) (a%ia(j)),(i),a%val(j)
end do end do

10
base/serial/impl/psb_d_csc_impl.f90
Unescape Escape View File

@ -2797,32 +2797,32 @@ subroutine psb_d_csc_print(iout,a,iv,eirs,eics,head,ivr,ivc)
write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))'
write(iout,*) nr, nc, nz write(iout,*) nr, nc, nz
if(present(iv)) then if(present(iv)) then
do i=1, nr do i=1, nc
do j=a%icp(i),a%icp(i+1)-1 do j=a%icp(i),a%icp(i+1)-1
write(iout,frmtv) iv(a%ia(j)),iv(i),a%val(j) write(iout,frmtv) iv(a%ia(j)),iv(i),a%val(j)
end do end do
enddo enddo
else else
if (present(ivr).and..not.present(ivc)) then if (present(ivr).and..not.present(ivc)) then
do i=1, nr do i=1, nc
do j=a%icp(i),a%icp(i+1)-1 do j=a%icp(i),a%icp(i+1)-1
write(iout,frmtv) ivr(a%ia(j)),i,a%val(j) write(iout,frmtv) ivr(a%ia(j)),i,a%val(j)
end do end do
enddo enddo
else if (present(ivr).and.present(ivc)) then else if (present(ivr).and.present(ivc)) then
do i=1, nr do i=1, nc
do j=a%icp(i),a%icp(i+1)-1 do j=a%icp(i),a%icp(i+1)-1
write(iout,frmtv) ivr(a%ia(j)),ivc(i),a%val(j) write(iout,frmtv) ivr(a%ia(j)),ivc(i),a%val(j)
end do end do
enddo enddo
else if (.not.present(ivr).and.present(ivc)) then else if (.not.present(ivr).and.present(ivc)) then
do i=1, nr do i=1, nc
do j=a%icp(i),a%icp(i+1)-1 do j=a%icp(i),a%icp(i+1)-1
write(iout,frmtv) (a%ia(j)),ivc(i),a%val(j) write(iout,frmtv) (a%ia(j)),ivc(i),a%val(j)
end do end do
enddo enddo
else if (.not.present(ivr).and..not.present(ivc)) then else if (.not.present(ivr).and..not.present(ivc)) then
do i=1, nr do i=1, nc
do j=a%icp(i),a%icp(i+1)-1 do j=a%icp(i),a%icp(i+1)-1
write(iout,frmtv) (a%ia(j)),(i),a%val(j) write(iout,frmtv) (a%ia(j)),(i),a%val(j)
end do end do

10
base/serial/impl/psb_s_csc_impl.f90
Unescape Escape View File

@ -2561,32 +2561,32 @@ subroutine psb_s_csc_print(iout,a,iv,eirs,eics,head,ivr,ivc)
write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))'
write(iout,*) nr, nc, nz write(iout,*) nr, nc, nz
if(present(iv)) then if(present(iv)) then
do i=1, nr do i=1, nc
do j=a%icp(i),a%icp(i+1)-1 do j=a%icp(i),a%icp(i+1)-1
write(iout,frmtv) iv(a%ia(j)),iv(i),a%val(j) write(iout,frmtv) iv(a%ia(j)),iv(i),a%val(j)
end do end do
enddo enddo
else else
if (present(ivr).and..not.present(ivc)) then if (present(ivr).and..not.present(ivc)) then
do i=1, nr do i=1, nc
do j=a%icp(i),a%icp(i+1)-1 do j=a%icp(i),a%icp(i+1)-1
write(iout,frmtv) ivr(a%ia(j)),i,a%val(j) write(iout,frmtv) ivr(a%ia(j)),i,a%val(j)
end do end do
enddo enddo
else if (present(ivr).and.present(ivc)) then else if (present(ivr).and.present(ivc)) then
do i=1, nr do i=1, nc
do j=a%icp(i),a%icp(i+1)-1 do j=a%icp(i),a%icp(i+1)-1
write(iout,frmtv) ivr(a%ia(j)),ivc(i),a%val(j) write(iout,frmtv) ivr(a%ia(j)),ivc(i),a%val(j)
end do end do
enddo enddo
else if (.not.present(ivr).and.present(ivc)) then else if (.not.present(ivr).and.present(ivc)) then
do i=1, nr do i=1, nc
do j=a%icp(i),a%icp(i+1)-1 do j=a%icp(i),a%icp(i+1)-1
write(iout,frmtv) (a%ia(j)),ivc(i),a%val(j) write(iout,frmtv) (a%ia(j)),ivc(i),a%val(j)
end do end do
enddo enddo
else if (.not.present(ivr).and..not.present(ivc)) then else if (.not.present(ivr).and..not.present(ivc)) then
do i=1, nr do i=1, nc
do j=a%icp(i),a%icp(i+1)-1 do j=a%icp(i),a%icp(i+1)-1
write(iout,frmtv) (a%ia(j)),(i),a%val(j) write(iout,frmtv) (a%ia(j)),(i),a%val(j)
end do end do

10
base/serial/impl/psb_z_csc_impl.f90
Unescape Escape View File

@ -2924,32 +2924,32 @@ subroutine psb_z_csc_print(iout,a,iv,eirs,eics,head,ivr,ivc)
write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))'
write(iout,*) nr, nc, nz write(iout,*) nr, nc, nz
if(present(iv)) then if(present(iv)) then
do i=1, nr do i=1, nc
do j=a%icp(i),a%icp(i+1)-1 do j=a%icp(i),a%icp(i+1)-1
write(iout,frmtv) iv(a%ia(j)),iv(i),a%val(j) write(iout,frmtv) iv(a%ia(j)),iv(i),a%val(j)
end do end do
enddo enddo
else else
if (present(ivr).and..not.present(ivc)) then if (present(ivr).and..not.present(ivc)) then
do i=1, nr do i=1, nc
do j=a%icp(i),a%icp(i+1)-1 do j=a%icp(i),a%icp(i+1)-1
write(iout,frmtv) ivr(a%ia(j)),i,a%val(j) write(iout,frmtv) ivr(a%ia(j)),i,a%val(j)
end do end do
enddo enddo
else if (present(ivr).and.present(ivc)) then else if (present(ivr).and.present(ivc)) then
do i=1, nr do i=1, nc
do j=a%icp(i),a%icp(i+1)-1 do j=a%icp(i),a%icp(i+1)-1
write(iout,frmtv) ivr(a%ia(j)),ivc(i),a%val(j) write(iout,frmtv) ivr(a%ia(j)),ivc(i),a%val(j)
end do end do
enddo enddo
else if (.not.present(ivr).and.present(ivc)) then else if (.not.present(ivr).and.present(ivc)) then
do i=1, nr do i=1, nc
do j=a%icp(i),a%icp(i+1)-1 do j=a%icp(i),a%icp(i+1)-1
write(iout,frmtv) (a%ia(j)),ivc(i),a%val(j) write(iout,frmtv) (a%ia(j)),ivc(i),a%val(j)
end do end do
enddo enddo
else if (.not.present(ivr).and..not.present(ivc)) then else if (.not.present(ivr).and..not.present(ivc)) then
do i=1, nr do i=1, nc
do j=a%icp(i),a%icp(i+1)-1 do j=a%icp(i),a%icp(i+1)-1
write(iout,frmtv) (a%ia(j)),(i),a%val(j) write(iout,frmtv) (a%ia(j)),(i),a%val(j)
end do end do

90
opt/psb_d_rsb_mat_mod.F90
Unescape Escape View File

@ -756,36 +756,36 @@ subroutine psb_d_rsb_csgetptn(imin,imax,a,nz,ia,ja,info,&
integer :: nzin_, jmin_, jmax_, err_act, i integer :: nzin_, jmin_, jmax_, err_act, i
character(len=20) :: name='csget' character(len=20) :: name='csget'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
PSBRSB_DEBUG('') PSBRSB_DEBUG('')
if (present(iren).or.present(rscale).or.present(cscale)) then if (present(iren).or.present(rscale).or.present(cscale)) then
! FIXME: error condition ! FIXME: error condition
PSBRSB_ERROR("unsupported optional arguments!") PSBRSB_ERROR("unsupported optional arguments!")
call psb_error() call psb_error()
endif endif
if (present(append)) then if (present(append)) then
append_ = append append_ = append
else else
append_ = .false. append_ = .false.
endif endif
if (present(append).and.append.and.present(nzin)) then if (present(append).and.append.and.present(nzin)) then
nzin_ = nzin nzin_ = nzin
else else
nzin_ = 0 nzin_ = 0
endif endif
if (present(jmin)) then if (present(jmin)) then
jmin_ = jmin jmin_ = jmin
else else
jmin_ = 1 jmin_ = 1
endif endif
if (present(jmax)) then if (present(jmax)) then
jmax_ = jmax jmax_ = jmax
else else
jmax_ = a%get_nrows() jmax_ = a%get_nrows()
endif endif
if (present(rscale)) then if (present(rscale)) then
rscale_ = rscale rscale_ = rscale
@ -804,34 +804,34 @@ subroutine psb_d_rsb_csgetptn(imin,imax,a,nz,ia,ja,info,&
end if end if
if (present(iren)) then if (present(iren)) then
info = c_psbrsb_err_ info = c_psbrsb_err_
PSBRSB_ERROR("ERROR: the RSB pattern get needs iren support !!") PSBRSB_ERROR("ERROR: the RSB pattern get needs iren support !!")
goto 9999 goto 9999
end if end if
!nzt = .. !nzt = ..
nz = 0 nz = 0
call psb_ensure_size(nzin_,ia,info) call psb_ensure_size(nzin_,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_,ja,info) if (info == psb_success_) call psb_ensure_size(nzin_,ja,info)
if (info /= psb_success_) return if (info /= psb_success_) return
nz=rsb_get_block_nnz(a%rsbmptr,imin,imax,jmin_,jmax_,c_for_flags,info) nz=rsb_get_block_nnz(a%rsbmptr,imin,imax,jmin_,jmax_,c_for_flags,info)
!write(*,*) 'debug:',nzin_,nz,imin,imax,jmin_,jmax_ !write(*,*) 'debug:',nzin_,nz,imin,imax,jmin_,jmax_
! FIXME: unfinished; missing error handling .. ! FIXME: unfinished; missing error handling ..
call psb_ensure_size(nzin_+nz,ia,info) call psb_ensure_size(nzin_+nz,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nz,ja,info) if (info == psb_success_) call psb_ensure_size(nzin_+nz,ja,info)
if (info /= psb_success_)then if (info /= psb_success_)then
PSBRSB_ERROR("!") PSBRSB_ERROR("!")
return return
endif endif
info=d_rsb_to_psb_info(rsb_get_block_sparse_pattern& info=d_rsb_to_psb_info(rsb_get_block_sparse_pattern&
&(a%rsbmptr,imin,imax,jmin_,jmax_,ia,ja,c_null_ptr,c_null_ptr,nzin_,c_for_flags)) &(a%rsbmptr,imin,imax,jmin_,jmax_,ia,ja,c_null_ptr,c_null_ptr,nzin_,c_for_flags))
! FIXME: unfinished; missing error handling .. ! FIXME: unfinished; missing error handling ..
!write(*,*) 'debug:',nzin_,nz,imin,imax,jmin_,jmax_ !write(*,*) 'debug:',nzin_,nz,imin,imax,jmin_,jmax_
if (rscale_) then if (rscale_) then
do i=nzin_+1, nzin_+nz do i=nzin_+1, nzin_+nz
ia(i) = ia(i) - imin + 1 ia(i) = ia(i) - imin + 1

3
prec/psb_d_diagprec.f90
Unescape Escape View File

@ -73,7 +73,8 @@ contains
else else
allocate(ww(size(x)),stat=info) allocate(ww(size(x)),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_request_,name,i_err=(/size(x),0,0,0,0/),a_err='real(psb_dpk_)') call psb_errpush(psb_err_alloc_request_,name,&
& i_err=(/size(x),0,0,0,0/),a_err='real(psb_dpk_)')
goto 9999 goto 9999
end if end if
end if end if

2
test/pargen/runs/ppde.inp
Unescape Escape View File

@ -2,7 +2,7 @@
BICGSTAB Iterative method BICGSTAB CGS BICG BICGSTABL RGMRES BICGSTAB Iterative method BICGSTAB CGS BICG BICGSTABL RGMRES
BJAC Preconditioner NONE DIAG BJAC BJAC Preconditioner NONE DIAG BJAC
CSR Storage format for matrix A: CSR COO JAD CSR Storage format for matrix A: CSR COO JAD
020 Domain size (acutal system is this**3) 001 Domain size (acutal system is this**3)
2 Stopping criterion 2 Stopping criterion
0200 MAXIT 0200 MAXIT
-1 ITRACE -1 ITRACE

Write Preview
Loading…
Cancel
Save