mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-16 10:52:08 +00:00
psblas3:
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.
This commit is contained in:
Salvatore Filippone
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
+46
-46
@@ -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
|
||||
|
||||
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 ..
|
||||
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
|
||||
|
||||
!write(*,*) 'debug:',nzin_,nz,imin,imax,jmin_,jmax_
|
||||
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_
|
||||
if (rscale_) then
|
||||
do i=nzin_+1, nzin_+nz
|
||||
ia(i) = ia(i) - imin + 1
|
||||
|
||||
@@ -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,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
|
||||
|
||||
Reference in New Issue
Block a user