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(iout,*) nr, nc, nz
if(present(iv)) then
do i=1, nr
do i=1, nc
do j=a%icp(i),a%icp(i+1)-1
write(iout,frmtv) iv(a%ia(j)),iv(i),a%val(j)
end do
enddo
else
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
write(iout,frmtv) ivr(a%ia(j)),i,a%val(j)
end do
enddo
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
write(iout,frmtv) ivr(a%ia(j)),ivc(i),a%val(j)
end do
enddo
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
write(iout,frmtv) (a%ia(j)),ivc(i),a%val(j)
end do
enddo
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
write(iout,frmtv) (a%ia(j)),(i),a%val(j)
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(iout,*) nr, nc, nz
if(present(iv)) then
do i=1, nr
do i=1, nc
do j=a%icp(i),a%icp(i+1)-1
write(iout,frmtv) iv(a%ia(j)),iv(i),a%val(j)
end do
enddo
else
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
write(iout,frmtv) ivr(a%ia(j)),i,a%val(j)
end do
enddo
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
write(iout,frmtv) ivr(a%ia(j)),ivc(i),a%val(j)
end do
enddo
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
write(iout,frmtv) (a%ia(j)),ivc(i),a%val(j)
end do
enddo
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
write(iout,frmtv) (a%ia(j)),(i),a%val(j)
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(iout,*) nr, nc, nz
if(present(iv)) then
do i=1, nr
do i=1, nc
do j=a%icp(i),a%icp(i+1)-1
write(iout,frmtv) iv(a%ia(j)),iv(i),a%val(j)
end do
enddo
else
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
write(iout,frmtv) ivr(a%ia(j)),i,a%val(j)
end do
enddo
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
write(iout,frmtv) ivr(a%ia(j)),ivc(i),a%val(j)
end do
enddo
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
write(iout,frmtv) (a%ia(j)),ivc(i),a%val(j)
end do
enddo
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
write(iout,frmtv) (a%ia(j)),(i),a%val(j)
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(iout,*) nr, nc, nz
if(present(iv)) then
do i=1, nr
do i=1, nc
do j=a%icp(i),a%icp(i+1)-1
write(iout,frmtv) iv(a%ia(j)),iv(i),a%val(j)
end do
enddo
else
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
write(iout,frmtv) ivr(a%ia(j)),i,a%val(j)
end do
enddo
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
write(iout,frmtv) ivr(a%ia(j)),ivc(i),a%val(j)
end do
enddo
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
write(iout,frmtv) (a%ia(j)),ivc(i),a%val(j)
end do
enddo
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
write(iout,frmtv) (a%ia(j)),(i),a%val(j)
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
character(len=20) :: name='csget'
logical, parameter :: debug=.false.
PSBRSB_DEBUG('')
PSBRSB_DEBUG('')
if (present(iren).or.present(rscale).or.present(cscale)) then
! FIXME: error condition
PSBRSB_ERROR("unsupported optional arguments!")
call psb_error()
endif
if (present(iren).or.present(rscale).or.present(cscale)) then
! FIXME: error condition
PSBRSB_ERROR("unsupported optional arguments!")
call psb_error()
endif
if (present(append)) then
append_ = append
else
append_ = .false.
endif
if (present(append).and.append.and.present(nzin)) then
nzin_ = nzin
else
nzin_ = 0
endif
if (present(append)) then
append_ = append
else
append_ = .false.
endif
if (present(append).and.append.and.present(nzin)) then
nzin_ = nzin
else
nzin_ = 0
endif
if (present(jmin)) then
jmin_ = jmin
else
jmin_ = 1
endif
if (present(jmin)) then
jmin_ = jmin
else
jmin_ = 1
endif
if (present(jmax)) then
jmax_ = jmax
else
jmax_ = a%get_nrows()
endif
if (present(jmax)) then
jmax_ = jmax
else
jmax_ = a%get_nrows()
endif
if (present(rscale)) then
rscale_ = rscale
@ -804,34 +804,34 @@ subroutine psb_d_rsb_csgetptn(imin,imax,a,nz,ia,ja,info,&
end if
if (present(iren)) then
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
end if
!nzt = ..
nz = 0
!nzt = ..
nz = 0
call psb_ensure_size(nzin_,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_,ja,info)
call psb_ensure_size(nzin_,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_,ja,info)
if (info /= psb_success_) return
nz=rsb_get_block_nnz(a%rsbmptr,imin,imax,jmin_,jmax_,c_for_flags,info)
!write(*,*) 'debug:',nzin_,nz,imin,imax,jmin_,jmax_
! FIXME: unfinished; missing error handling ..
if (info /= psb_success_) return
nz=rsb_get_block_nnz(a%rsbmptr,imin,imax,jmin_,jmax_,c_for_flags,info)
!write(*,*) 'debug:',nzin_,nz,imin,imax,jmin_,jmax_
! FIXME: unfinished; missing error handling ..
call psb_ensure_size(nzin_+nz,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nz,ja,info)
if (info /= psb_success_)then
PSBRSB_ERROR("!")
return
endif
call psb_ensure_size(nzin_+nz,ia,info)
if (info == psb_success_) call psb_ensure_size(nzin_+nz,ja,info)
if (info /= psb_success_)then
PSBRSB_ERROR("!")
return
endif
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))
! FIXME: unfinished; missing error handling ..
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))
! FIXME: unfinished; missing error handling ..
!write(*,*) 'debug:',nzin_,nz,imin,imax,jmin_,jmax_
!write(*,*) 'debug:',nzin_,nz,imin,imax,jmin_,jmax_
if (rscale_) then
do i=nzin_+1, nzin_+nz
ia(i) = ia(i) - imin + 1

3
prec/psb_d_diagprec.f90
Unescape Escape View File

@ -73,7 +73,8 @@ contains
else
allocate(ww(size(x)),stat=info)
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
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
BJAC Preconditioner NONE DIAG BJAC
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
0200 MAXIT
-1 ITRACE

Write Preview
Loading…
Cancel
Save