diff --git a/test/fileread/cf_sample.f90 b/test/fileread/cf_sample.f90 index 2a777924..7279057d 100644 --- a/test/fileread/cf_sample.f90 +++ b/test/fileread/cf_sample.f90 @@ -286,27 +286,23 @@ program cf_sample & desc_a%indxmap%get_fmt() end if - allocate(x_col_glob(m_problem),r_col_glob(m_problem),stat=ierr) - if (ierr /= 0) then - write(psb_err_unit,*) 'allocation error: no data collection' - else - call psb_gather(x_col_glob,x_col,desc_a,info,root=psb_root_) - call psb_gather(r_col_glob,r_col,desc_a,info,root=psb_root_) - if (iam == psb_root_) then - write(psb_err_unit,'(" ")') - write(psb_err_unit,'("Saving x on file")') - write(20,*) 'matrix: ',mtrx_file - write(20,*) 'computed solution on ',np,' processors.' - write(20,*) 'iterations to convergence: ',iter - write(20,*) 'error estimate (infinity norm) on exit:', & - & ' ||r||/(||a||||x||+||b||) = ',err - write(20,'("Residual norm 2 : ",es12.5)')resmx - write(20,'("Residual norm inf : ",es12.5)')resmxp - write(20,'(a8,4(2x,a20))') 'I','X(I)','R(I)','B(I)' - do i=1,m_problem - write(20,998) i,x_col_glob(i),r_col_glob(i),b_col_glob(i) - enddo - end if + call psb_gather(x_col_glob,x_col,desc_a,info,root=psb_root_) + if (info == psb_success_) & + & call psb_gather(r_col_glob,r_col,desc_a,info,root=psb_root_) + if (iam == psb_root_) then + write(psb_err_unit,'(" ")') + write(psb_err_unit,'("Saving x on file")') + write(20,*) 'matrix: ',mtrx_file + write(20,*) 'computed solution on ',np,' processors.' + write(20,*) 'iterations to convergence: ',iter + write(20,*) 'error estimate (infinity norm) on exit:', & + & ' ||r||/(||a||||x||+||b||) = ',err + write(20,'("Residual norm 2 : ",es12.5)')resmx + write(20,'("Residual norm inf : ",es12.5)')resmxp + write(20,'(a8,4(2x,a20))') 'I','X(I)','R(I)','B(I)' + do i=1,m_problem + write(20,998) i,x_col_glob(i),r_col_glob(i),b_col_glob(i) + enddo end if 998 format(i8,6(1x,g11.5)) 993 format(i6,4(1x,e12.6)) diff --git a/test/fileread/df_sample.f90 b/test/fileread/df_sample.f90 index bfab6928..e7e25930 100644 --- a/test/fileread/df_sample.f90 +++ b/test/fileread/df_sample.f90 @@ -293,27 +293,23 @@ program df_sample end if !!$ call psb_precdump(prec,info,prefix=trim(mtrx_file)//'_') - allocate(x_col_glob(m_problem),r_col_glob(m_problem),stat=ierr) - if (ierr /= 0) then - write(psb_err_unit,*) 'allocation error: no data collection' - else - call psb_gather(x_col_glob,x_col,desc_a,info,root=psb_root_) - call psb_gather(r_col_glob,r_col,desc_a,info,root=psb_root_) - if (iam == psb_root_) then - write(psb_err_unit,'(" ")') - write(psb_err_unit,'("Saving x on file")') - write(20,*) 'matrix: ',mtrx_file - write(20,*) 'computed solution on ',np,' processors.' - write(20,*) 'iterations to convergence: ',iter - write(20,*) 'error estimate (infinity norm) on exit:', & - & ' ||r||/(||a||||x||+||b||) = ',err - write(20,'("Residual norm 2 : ",es12.5)')resmx - write(20,'("Residual norm inf : ",es12.5)')resmxp - write(20,'(a8,4(2x,a20))') 'I','X(I)','R(I)','B(I)' - do i=1,m_problem - write(20,998) i,x_col_glob(i),r_col_glob(i),b_col_glob(i) - enddo - end if + call psb_gather(x_col_glob,x_col,desc_a,info,root=psb_root_) + if (info == psb_success_) & + & call psb_gather(r_col_glob,r_col,desc_a,info,root=psb_root_) + if (iam == psb_root_) then + write(psb_err_unit,'(" ")') + write(psb_err_unit,'("Saving x on file")') + write(20,*) 'matrix: ',mtrx_file + write(20,*) 'computed solution on ',np,' processors.' + write(20,*) 'iterations to convergence: ',iter + write(20,*) 'error estimate (infinity norm) on exit:', & + & ' ||r||/(||a||||x||+||b||) = ',err + write(20,'("Residual norm 2 : ",es12.5)')resmx + write(20,'("Residual norm inf : ",es12.5)')resmxp + write(20,'(a8,4(2x,a20))') 'I','X(I)','R(I)','B(I)' + do i=1,m_problem + write(20,998) i,x_col_glob(i),r_col_glob(i),b_col_glob(i) + enddo end if 998 format(i8,4(2x,g20.14)) 993 format(i6,4(1x,e12.6)) diff --git a/test/fileread/sf_sample.f90 b/test/fileread/sf_sample.f90 index 39fba0d7..5794e9af 100644 --- a/test/fileread/sf_sample.f90 +++ b/test/fileread/sf_sample.f90 @@ -290,27 +290,23 @@ program sf_sample end if !!$ call psb_precdump(prec,info,prefix=trim(mtrx_file)//'_') - allocate(x_col_glob(m_problem),r_col_glob(m_problem),stat=ierr) - if (ierr /= 0) then - write(psb_err_unit,*) 'allocation error: no data collection' - else - call psb_gather(x_col_glob,x_col,desc_a,info,root=psb_root_) - call psb_gather(r_col_glob,r_col,desc_a,info,root=psb_root_) - if (iam == psb_root_) then - write(psb_err_unit,'(" ")') - write(psb_err_unit,'("Saving x on file")') - write(20,*) 'matrix: ',mtrx_file - write(20,*) 'computed solution on ',np,' processors.' - write(20,*) 'iterations to convergence: ',iter - write(20,*) 'error estimate (infinity norm) on exit:', & - & ' ||r||/(||a||||x||+||b||) = ',err - write(20,'("Residual norm 2 : ",es12.5)')resmx - write(20,'("Residual norm inf : ",es12.5)')resmxp - write(20,'(a8,4(2x,a20))') 'I','X(I)','R(I)','B(I)' - do i=1,m_problem - write(20,998) i,x_col_glob(i),r_col_glob(i),b_col_glob(i) - enddo - end if + call psb_gather(x_col_glob,x_col,desc_a,info,root=psb_root_) + if (info == psb_success_) & + & call psb_gather(r_col_glob,r_col,desc_a,info,root=psb_root_) + if (iam == psb_root_) then + write(psb_err_unit,'(" ")') + write(psb_err_unit,'("Saving x on file")') + write(20,*) 'matrix: ',mtrx_file + write(20,*) 'computed solution on ',np,' processors.' + write(20,*) 'iterations to convergence: ',iter + write(20,*) 'error estimate (infinity norm) on exit:', & + & ' ||r||/(||a||||x||+||b||) = ',err + write(20,'("Residual norm 2 : ",es12.5)')resmx + write(20,'("Residual norm inf : ",es12.5)')resmxp + write(20,'(a8,4(2x,a20))') 'I','X(I)','R(I)','B(I)' + do i=1,m_problem + write(20,998) i,x_col_glob(i),r_col_glob(i),b_col_glob(i) + enddo end if 998 format(i8,4(2x,g20.14)) 993 format(i6,4(1x,e12.6)) diff --git a/test/fileread/zf_sample.f90 b/test/fileread/zf_sample.f90 index 994a7b2e..97d5c85e 100644 --- a/test/fileread/zf_sample.f90 +++ b/test/fileread/zf_sample.f90 @@ -286,27 +286,23 @@ program zf_sample & desc_a%indxmap%get_fmt() end if - allocate(x_col_glob(m_problem),r_col_glob(m_problem),stat=ierr) - if (ierr /= 0) then - write(psb_err_unit,*) 'allocation error: no data collection' - else - call psb_gather(x_col_glob,x_col,desc_a,info,root=psb_root_) - call psb_gather(r_col_glob,r_col,desc_a,info,root=psb_root_) - if (iam == psb_root_) then - write(psb_err_unit,'(" ")') - write(psb_err_unit,'("Saving x on file")') - write(20,*) 'matrix: ',mtrx_file - write(20,*) 'computed solution on ',np,' processors.' - write(20,*) 'iterations to convergence: ',iter - write(20,*) 'error estimate (infinity norm) on exit:', & - & ' ||r||/(||a||||x||+||b||) = ',err - write(20,'("Residual norm 2 : ",es12.5)')resmx - write(20,'("Residual norm inf : ",es12.5)')resmxp - write(20,'(a8,4(2x,a20))') 'I','X(I)','R(I)','B(I)' - do i=1,m_problem - write(20,998) i,x_col_glob(i),r_col_glob(i),b_col_glob(i) - enddo - end if + call psb_gather(x_col_glob,x_col,desc_a,info,root=psb_root_) + if (info == psb_success_) & + & call psb_gather(r_col_glob,r_col,desc_a,info,root=psb_root_) + if (iam == psb_root_) then + write(psb_err_unit,'(" ")') + write(psb_err_unit,'("Saving x on file")') + write(20,*) 'matrix: ',mtrx_file + write(20,*) 'computed solution on ',np,' processors.' + write(20,*) 'iterations to convergence: ',iter + write(20,*) 'error estimate (infinity norm) on exit:', & + & ' ||r||/(||a||||x||+||b||) = ',err + write(20,'("Residual norm 2 : ",es12.5)')resmx + write(20,'("Residual norm inf : ",es12.5)')resmxp + write(20,'(a8,4(2x,a20))') 'I','X(I)','R(I)','B(I)' + do i=1,m_problem + write(20,998) i,x_col_glob(i),r_col_glob(i),b_col_glob(i) + enddo end if 998 format(i8,6(1x,g11.5)) 993 format(i6,4(1x,e12.6))