diff --git a/base/serial/impl/psb_c_csc_impl.f90 b/base/serial/impl/psb_c_csc_impl.f90 index 61c8aad4..6f8dd6fb 100644 --- a/base/serial/impl/psb_c_csc_impl.f90 +++ b/base/serial/impl/psb_c_csc_impl.f90 @@ -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 diff --git a/base/serial/impl/psb_d_csc_impl.f90 b/base/serial/impl/psb_d_csc_impl.f90 index 77e79c47..a695a87c 100644 --- a/base/serial/impl/psb_d_csc_impl.f90 +++ b/base/serial/impl/psb_d_csc_impl.f90 @@ -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 diff --git a/base/serial/impl/psb_s_csc_impl.f90 b/base/serial/impl/psb_s_csc_impl.f90 index afeef65c..f42f54ee 100644 --- a/base/serial/impl/psb_s_csc_impl.f90 +++ b/base/serial/impl/psb_s_csc_impl.f90 @@ -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 diff --git a/base/serial/impl/psb_z_csc_impl.f90 b/base/serial/impl/psb_z_csc_impl.f90 index 54f5bf3a..6f978825 100644 --- a/base/serial/impl/psb_z_csc_impl.f90 +++ b/base/serial/impl/psb_z_csc_impl.f90 @@ -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 diff --git a/opt/psb_d_rsb_mat_mod.F90 b/opt/psb_d_rsb_mat_mod.F90 index 86904639..e80763c9 100644 --- a/opt/psb_d_rsb_mat_mod.F90 +++ b/opt/psb_d_rsb_mat_mod.F90 @@ -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 + + 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 diff --git a/prec/psb_d_diagprec.f90 b/prec/psb_d_diagprec.f90 index 36f7f14a..3ce66f2f 100644 --- a/prec/psb_d_diagprec.f90 +++ b/prec/psb_d_diagprec.f90 @@ -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 diff --git a/test/pargen/runs/ppde.inp b/test/pargen/runs/ppde.inp index b3be25f9..8e416ec9 100644 --- a/test/pargen/runs/ppde.inp +++ b/test/pargen/runs/ppde.inp @@ -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