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/comm/psb_dhalo.f90
 base/comm/psb_dspgather.F90
 base/comm/psb_shalo.f90
 base/internals/psi_bld_g2lmap.f90
 base/internals/psi_bld_tmphalo.f90
 base/internals/psi_cswapdata.F90
 base/internals/psi_cswaptran.F90
 base/internals/psi_desc_index.F90
 base/internals/psi_dl_check.f90
 base/internals/psi_dswapdata.F90
 base/internals/psi_dswaptran.F90
 base/internals/psi_extrct_dl.F90
 base/internals/psi_fnd_owner.F90
 base/internals/psi_iswapdata.F90
 base/internals/psi_iswaptran.F90
 base/internals/psi_sswapdata.F90
 base/internals/psi_sswaptran.F90
 base/internals/psi_zswapdata.F90
 base/internals/psi_zswaptran.F90
 base/internals/srtlist.f
 base/modules/psb_base_mat_mod.f03
 base/modules/psb_c_tools_mod.f90
 base/modules/psb_const_mod.F90
 base/modules/psb_d_tools_mod.f90
 base/modules/psb_desc_type.f90
 base/modules/psb_error_impl.F90
 base/modules/psb_error_mod.F90
 base/modules/psb_gps_mod.f90
 base/modules/psb_hash_mod.f90
 base/modules/psb_realloc_mod.F90
 base/modules/psb_s_tools_mod.f90
 base/modules/psb_z_tools_mod.f90
 base/modules/psi_comm_buffers_mod.F90
 base/modules/psi_p2p_mod.F90
 base/modules/psi_penv_mod.F90
 base/psblas/psb_sxdot.f90
 base/serial/aux/dasrx.f90
 base/serial/aux/dmsr.f90
 base/serial/aux/dmsrx.f90
 base/serial/aux/zamsr.f90
 base/serial/f03/psb_c_coo_impl.f03
 base/serial/f03/psb_c_mat_impl.f03
 base/serial/f03/psb_d_coo_impl.f03
 base/serial/f03/psb_d_mat_impl.f03
 base/serial/f03/psb_s_coo_impl.f03
 base/serial/f03/psb_s_mat_impl.f03
 base/serial/f03/psb_z_coo_impl.f03
 base/serial/f03/psb_z_mat_impl.f03
 base/serial/f77/smmp.f
 base/serial/psb_cnumbmm.f90
 base/serial/psb_crwextd.f90
 base/serial/psb_csymbmm.f90
 base/serial/psb_dnumbmm.f90
 base/serial/psb_drwextd.f90
 base/serial/psb_dsymbmm.f90
 base/serial/psb_snumbmm.f90
 base/serial/psb_sort_impl.f90
 base/serial/psb_srwextd.f90
 base/serial/psb_ssymbmm.f90
 base/serial/psb_znumbmm.f90
 base/serial/psb_zrwextd.f90
 base/serial/psb_zsymbmm.f90
 base/serial/psi_impl.f90
 base/tools/psb_ccdbldext.F90
 base/tools/psb_cd_inloc.f90
 base/tools/psb_cd_set_bld.f90
 base/tools/psb_cdins.f90
 base/tools/psb_cspins.f90
 base/tools/psb_dcdbldext.F90
 base/tools/psb_dspins.f90
 base/tools/psb_glob_to_loc.f90
 base/tools/psb_linmap.f90
 base/tools/psb_loc_to_glob.f90
 base/tools/psb_map.f90
 base/tools/psb_scdbldext.F90
 base/tools/psb_sspins.f90
 base/tools/psb_zcdbldext.F90
 base/tools/psb_zspins.f90
 config/pac.m4
 configure.ac
 configure
 krylov/psb_base_inner_krylov_mod.f90
 krylov/psb_ckrylov.f90
 krylov/psb_dkrylov.f90
 krylov/psb_skrylov.f90
 krylov/psb_zkrylov.f90
 prec/psb_c_bjacprec.f03
 prec/psb_cilu_fct.f90
 prec/psb_cprecinit.f90
 prec/psb_d_bjacprec.f03
 prec/psb_dilu_fct.f90
 prec/psb_dprecinit.f90
 prec/psb_prec_const_mod.f03
 prec/psb_s_bjacprec.f03
 prec/psb_silu_fct.f90
 prec/psb_sprecinit.f90
 prec/psb_z_bjacprec.f03
 prec/psb_zilu_fct.f90
 prec/psb_zprecinit.f90
 test/fileread/cf_sample.f90
 test/fileread/df_sample.f90
 test/fileread/getp.f90
 test/fileread/sf_sample.f90
 test/fileread/zf_sample.f90
 test/pargen/ppde.f90
 test/pargen/spde.f90
 test/serial/d_coo_matgen.f03
 test/serial/d_matgen.f03
 test/torture/psbtf.f90
 util/psb_hbio_impl.f90
 util/psb_mat_dist_impl.f90
 util/psb_metispart_mod.F90
 util/psb_mmio_impl.f90


I/O changes with ISO_FORTRAN_ENV psb_XXX_unit & friends.
psblas3-type-indexed
Salvatore Filippone 15 years ago
parent 2944313023
commit 18ecc8983c
113 changed files with 1036 additions and 924 deletions
Show Stats Download Patch File Download Diff File

2
base/comm/psb_dhalo.f90
Unescape Escape View File

@ -174,7 +174,7 @@ subroutine psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
end if
else
aliw=.true.
!!$ write(0,*) 'halom ',liwork
!!$ write(psb_err_unit,*) 'halom ',liwork
allocate(iwork(liwork),stat=info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_

2
base/comm/psb_dspgather.F90
Unescape Escape View File

@ -93,7 +93,7 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
call globa%mv_from(glob_coo)
else
write(0,*) 'SP_ALLGATHER: Not implemented yet with keepnum ',keepnum_
write(psb_err_unit,*) 'SP_ALLGATHER: Not implemented yet with keepnum ',keepnum_
end if

2
base/comm/psb_shalo.f90
Unescape Escape View File

@ -174,7 +174,7 @@ subroutine psb_shalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
end if
else
aliw=.true.
!!$ write(0,*) 'halom ',liwork
!!$ write(psb_err_unit,*) 'halom ',liwork
allocate(iwork(liwork),stat=info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_

2
base/internals/psi_bld_g2lmap.f90
Unescape Escape View File

@ -92,7 +92,7 @@ subroutine psi_bld_g2lmap(desc,info)
if (hsize < 0) then
! This should never happen for sane values
! of psb_max_hash_bits.
write(0,*) 'Error: hash size overflow ',hsize,nbits
write(psb_err_unit,*) 'Error: hash size overflow ',hsize,nbits
info = -2
return
end if

2
base/internals/psi_bld_tmphalo.f90
Unescape Escape View File

@ -123,7 +123,7 @@ subroutine psi_bld_tmphalo(desc,info)
do i=1,nh
tmphl(j+0) = hproc(i)
if (tmphl(j+0)<0) then
write(0,*) 'Unrecoverable error: missing proc from asb'
write(psb_err_unit,*) 'Unrecoverable error: missing proc from asb'
end if
tmphl(j+1) = 1
tmphl(j+2) = n_row+i

8
base/internals/psi_cswapdata.F90
Unescape Escape View File

@ -330,7 +330,7 @@ subroutine psi_cswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
end if
rcvbuf(rcv_pt:rcv_pt+n*nerv-1) = sndbuf(snd_pt:snd_pt+n*nesd-1)
end if
@ -423,7 +423,7 @@ subroutine psi_cswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
end if
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
end if
rcvbuf(rcv_pt:rcv_pt+n*nerv-1) = sndbuf(snd_pt:snd_pt+n*nesd-1)
end if
@ -821,7 +821,7 @@ subroutine psi_cswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
end if
rcvbuf(rcv_pt:rcv_pt+nerv-1) = sndbuf(snd_pt:snd_pt+nesd-1)
end if
@ -910,7 +910,7 @@ subroutine psi_cswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
end if
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
end if
rcvbuf(rcv_pt:rcv_pt+nerv-1) = sndbuf(snd_pt:snd_pt+nesd-1)
end if

8
base/internals/psi_cswaptran.F90
Unescape Escape View File

@ -340,7 +340,7 @@ subroutine psi_ctranidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
end if
sndbuf(snd_pt:snd_pt+n*nesd-1) = rcvbuf(rcv_pt:rcv_pt+n*nerv-1)
end if
@ -429,7 +429,7 @@ subroutine psi_ctranidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
end if
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
end if
sndbuf(snd_pt:snd_pt+n*nesd-1) = rcvbuf(rcv_pt:rcv_pt+n*nerv-1)
end if
@ -829,7 +829,7 @@ subroutine psi_ctranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
end if
sndbuf(snd_pt:snd_pt+nesd-1) = rcvbuf(rcv_pt:rcv_pt+nerv-1)
end if
@ -917,7 +917,7 @@ subroutine psi_ctranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
end if
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
end if
sndbuf(snd_pt:snd_pt+nesd-1) = rcvbuf(rcv_pt:rcv_pt+nerv-1)
end if

4
base/internals/psi_desc_index.F90
Unescape Escape View File

@ -205,7 +205,7 @@ subroutine psi_desc_index(desc,index_in,dep_list,&
nrcv = iszs
if ((iszs /= idxs).or.(iszr /= idxr)) then
write(0,*) me, trim(name),': Warning: strange results?', &
write(psb_err_unit,*) me, trim(name),': Warning: strange results?', &
& iszs,idxs,iszr,idxr
end if
if (debug_level >= psb_debug_inner_) then
@ -242,7 +242,7 @@ subroutine psi_desc_index(desc,index_in,dep_list,&
i = 1
do
if (i > ihinsz) then
!!$ write(0,*) me,' did not find index_in end??? ',i,ihinsz
!!$ write(psb_err_unit,*) me,' did not find index_in end??? ',i,ihinsz
exit
end if
if (index_in(i) == -1) exit

4
base/internals/psi_dl_check.f90
Unescape Escape View File

@ -79,12 +79,12 @@ subroutine psi_dl_check(dep_list,dl_lda,np,length_dl)
! ...add proc to proc2 s dep_list.....',proc,proc2
length_dl(proc2) = length_dl(proc2)+1
if (length_dl(proc2) > size(dep_list,1)) then
write(0,*)'error in crea_halo', proc2,proc,&
write(psb_err_unit,*)'error in crea_halo', proc2,proc,&
& length_dl(proc2),'>',size(dep_list,1)
endif
dep_list(length_dl(proc2),proc2) = proc
else if (dep_list(j,proc2) /= proc) then
write(0,*) 'PSI_DL_CHECK This should not happen!!! ',&
write(psb_err_unit,*) 'PSI_DL_CHECK This should not happen!!! ',&
& j,proc2,dep_list(j,proc2),proc
endif
endif

8
base/internals/psi_dswapdata.F90
Unescape Escape View File

@ -331,7 +331,7 @@ subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
end if
rcvbuf(rcv_pt:rcv_pt+n*nerv-1) = sndbuf(snd_pt:snd_pt+n*nesd-1)
end if
@ -424,7 +424,7 @@ subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
end if
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
end if
rcvbuf(rcv_pt:rcv_pt+n*nerv-1) = sndbuf(snd_pt:snd_pt+n*nesd-1)
end if
@ -821,7 +821,7 @@ subroutine psi_dswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
end if
rcvbuf(rcv_pt:rcv_pt+nerv-1) = sndbuf(snd_pt:snd_pt+nesd-1)
end if
@ -910,7 +910,7 @@ subroutine psi_dswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
end if
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
end if
rcvbuf(rcv_pt:rcv_pt+nerv-1) = sndbuf(snd_pt:snd_pt+nesd-1)
end if

8
base/internals/psi_dswaptran.F90
Unescape Escape View File

@ -340,7 +340,7 @@ subroutine psi_dtranidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
end if
sndbuf(snd_pt:snd_pt+n*nesd-1) = rcvbuf(rcv_pt:rcv_pt+n*nerv-1)
end if
@ -429,7 +429,7 @@ subroutine psi_dtranidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
end if
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
end if
sndbuf(snd_pt:snd_pt+n*nesd-1) = rcvbuf(rcv_pt:rcv_pt+n*nerv-1)
end if
@ -826,7 +826,7 @@ subroutine psi_dtranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
end if
sndbuf(snd_pt:snd_pt+nesd-1) = rcvbuf(rcv_pt:rcv_pt+nerv-1)
end if
@ -914,7 +914,7 @@ subroutine psi_dtranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
end if
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
end if
sndbuf(snd_pt:snd_pt+nesd-1) = rcvbuf(rcv_pt:rcv_pt+nerv-1)
end if

2
base/internals/psi_extrct_dl.F90
Unescape Escape View File

@ -182,7 +182,7 @@ subroutine psi_extract_dep_list(desc_data,desc_str,dep_list,&
int_err(2) = desc_str(i)
goto 998
endif
! if((me == 1).and.(proc == 3))write(0,*)'found 3'
! if((me == 1).and.(proc == 3))write(psb_err_unit,*)'found 3'
if (mode == 1) then
! ...search if already exist proc
! in dep_list(*,me)...

10
base/internals/psi_fnd_owner.F90
Unescape Escape View File

@ -239,7 +239,7 @@ subroutine psi_fnd_owner(nv,idx,iprc,desc,info)
! Last resort attempt.
j = psb_ibsrch(ih,size(answers,1),answers(:,1))
if (j == -1) then
write(0,*) me,'psi_fnd_owner: searching for ',ih, &
write(psb_err_unit,*) me,'psi_fnd_owner: searching for ',ih, &
& 'not found : ',size(answers,1),':',answers(:,1)
info = psb_err_internal_error_
call psb_errpush(psb_err_internal_error_,name,a_err='out bounds srch ih')
@ -251,7 +251,7 @@ subroutine psi_fnd_owner(nv,idx,iprc,desc,info)
k = j
j = psb_ibsrch(ih,k,answers(1:k,1))
if (j == -1) then
write(0,*) me,'psi_fnd_owner: searching for ',ih, &
write(psb_err_unit,*) me,'psi_fnd_owner: searching for ',ih, &
& 'not found : ',size(answers,1),':',answers(:,1)
info = psb_err_internal_error_
call psb_errpush(psb_err_internal_error_,name,a_err='out bounds srch ih')
@ -283,9 +283,9 @@ subroutine psi_fnd_owner(nv,idx,iprc,desc,info)
call psb_amx(ictxt,tidx)
call psb_amx(ictxt,t1)
if (me == psb_root_) then
write(*,'(" fnd_owner idx time : ",es10.4)') tidx
write(*,'(" fnd_owner amx time : ",es10.4)') tamx
write(*,'(" fnd_owner remainedr : ",es10.4)') t1
write(psb_out_unit,'(" fnd_owner idx time : ",es10.4)') tidx
write(psb_out_unit,'(" fnd_owner amx time : ",es10.4)') tamx
write(psb_out_unit,'(" fnd_owner remainedr : ",es10.4)') t1
endif
end if

8
base/internals/psi_iswapdata.F90
Unescape Escape View File

@ -330,7 +330,7 @@ subroutine psi_iswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
end if
rcvbuf(rcv_pt:rcv_pt+n*nerv-1) = sndbuf(snd_pt:snd_pt+n*nesd-1)
end if
@ -423,7 +423,7 @@ subroutine psi_iswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
end if
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
end if
rcvbuf(rcv_pt:rcv_pt+n*nerv-1) = sndbuf(snd_pt:snd_pt+n*nesd-1)
end if
@ -821,7 +821,7 @@ subroutine psi_iswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
end if
rcvbuf(rcv_pt:rcv_pt+nerv-1) = sndbuf(snd_pt:snd_pt+nesd-1)
end if
@ -910,7 +910,7 @@ subroutine psi_iswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
end if
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
end if
rcvbuf(rcv_pt:rcv_pt+nerv-1) = sndbuf(snd_pt:snd_pt+nesd-1)
end if

8
base/internals/psi_iswaptran.F90
Unescape Escape View File

@ -340,7 +340,7 @@ subroutine psi_itranidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
end if
sndbuf(snd_pt:snd_pt+n*nesd-1) = rcvbuf(rcv_pt:rcv_pt+n*nerv-1)
end if
@ -429,7 +429,7 @@ subroutine psi_itranidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
end if
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
end if
sndbuf(snd_pt:snd_pt+n*nesd-1) = rcvbuf(rcv_pt:rcv_pt+n*nerv-1)
end if
@ -829,7 +829,7 @@ subroutine psi_itranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
end if
sndbuf(snd_pt:snd_pt+nesd-1) = rcvbuf(rcv_pt:rcv_pt+nerv-1)
end if
@ -917,7 +917,7 @@ subroutine psi_itranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
end if
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
end if
sndbuf(snd_pt:snd_pt+nesd-1) = rcvbuf(rcv_pt:rcv_pt+nerv-1)
end if

8
base/internals/psi_sswapdata.F90
Unescape Escape View File

@ -331,7 +331,7 @@ subroutine psi_sswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
end if
rcvbuf(rcv_pt:rcv_pt+n*nerv-1) = sndbuf(snd_pt:snd_pt+n*nesd-1)
end if
@ -424,7 +424,7 @@ subroutine psi_sswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
end if
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
end if
rcvbuf(rcv_pt:rcv_pt+n*nerv-1) = sndbuf(snd_pt:snd_pt+n*nesd-1)
end if
@ -821,7 +821,7 @@ subroutine psi_sswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
end if
rcvbuf(rcv_pt:rcv_pt+nerv-1) = sndbuf(snd_pt:snd_pt+nesd-1)
end if
@ -910,7 +910,7 @@ subroutine psi_sswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
end if
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
end if
rcvbuf(rcv_pt:rcv_pt+nerv-1) = sndbuf(snd_pt:snd_pt+nesd-1)
end if

8
base/internals/psi_sswaptran.F90
Unescape Escape View File

@ -340,7 +340,7 @@ subroutine psi_stranidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
end if
sndbuf(snd_pt:snd_pt+n*nesd-1) = rcvbuf(rcv_pt:rcv_pt+n*nerv-1)
end if
@ -429,7 +429,7 @@ subroutine psi_stranidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
end if
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
end if
sndbuf(snd_pt:snd_pt+n*nesd-1) = rcvbuf(rcv_pt:rcv_pt+n*nerv-1)
end if
@ -826,7 +826,7 @@ subroutine psi_stranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
end if
sndbuf(snd_pt:snd_pt+nesd-1) = rcvbuf(rcv_pt:rcv_pt+nerv-1)
end if
@ -914,7 +914,7 @@ subroutine psi_stranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
end if
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
end if
sndbuf(snd_pt:snd_pt+nesd-1) = rcvbuf(rcv_pt:rcv_pt+nerv-1)
end if

8
base/internals/psi_zswapdata.F90
Unescape Escape View File

@ -330,7 +330,7 @@ subroutine psi_zswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
& sndbuf(snd_pt:snd_pt+n*nesd-1), proc_to_comm)
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
end if
rcvbuf(rcv_pt:rcv_pt+n*nerv-1) = sndbuf(snd_pt:snd_pt+n*nesd-1)
end if
@ -423,7 +423,7 @@ subroutine psi_zswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
end if
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
end if
rcvbuf(rcv_pt:rcv_pt+n*nerv-1) = sndbuf(snd_pt:snd_pt+n*nesd-1)
end if
@ -821,7 +821,7 @@ subroutine psi_zswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
& sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
end if
rcvbuf(rcv_pt:rcv_pt+nerv-1) = sndbuf(snd_pt:snd_pt+nesd-1)
end if
@ -910,7 +910,7 @@ subroutine psi_zswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
end if
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swapdata: mismatch on self sendf',nerv,nesd
end if
rcvbuf(rcv_pt:rcv_pt+nerv-1) = sndbuf(snd_pt:snd_pt+nesd-1)
end if

8
base/internals/psi_zswaptran.F90
Unescape Escape View File

@ -340,7 +340,7 @@ subroutine psi_ztranidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
& rcvbuf(rcv_pt:rcv_pt+n*nerv-1), proc_to_comm)
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
end if
sndbuf(snd_pt:snd_pt+n*nesd-1) = rcvbuf(rcv_pt:rcv_pt+n*nerv-1)
end if
@ -429,7 +429,7 @@ subroutine psi_ztranidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
end if
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
end if
sndbuf(snd_pt:snd_pt+n*nesd-1) = rcvbuf(rcv_pt:rcv_pt+n*nerv-1)
end if
@ -829,7 +829,7 @@ subroutine psi_ztranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
& rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
end if
sndbuf(snd_pt:snd_pt+nesd-1) = rcvbuf(rcv_pt:rcv_pt+nerv-1)
end if
@ -917,7 +917,7 @@ subroutine psi_ztranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
end if
else if (proc_to_comm == me) then
if (nesd /= nerv) then
write(0,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
write(psb_err_unit,*) 'Fatal error in swaptran: mismatch on self sendf',nerv,nesd
end if
sndbuf(snd_pt:snd_pt+nesd-1) = rcvbuf(rcv_pt:rcv_pt+nerv-1)
end if

21
base/internals/srtlist.f
Unescape Escape View File

@ -105,7 +105,8 @@ C
DO I=1, NP
DO J=1, DG(I)
IP = DEP_LIST(J,I) + 1
c$$$ write(0,*) 'SRTLIST Input :',i,ip
c$$$ write(psb_err_unit,*)
c$$$ 'SRTLIST Input :',i,ip
IF (IP.GT.I)
+ NEDGES = NEDGES + 1
ENDDO
@ -148,11 +149,13 @@ c$$$ write(0,*) 'SRTLIST Input :',i,ip
ENDIF
ENDDO
IF (NCH.eq.0) THEN
write(0,*) 'SRTLIST ?????? Impossible error !!!!!?????',
write(psb_err_unit,*)
+ 'SRTLIST ?????? Impossible error !!!!!?????',
+ nedges,ist
do i=ist, nedges
IX = IDX(I)+IST-1
write(0,*) 'SRTLIST: Edge:',ix,edges(1,ix),
write(psb_err_unit,*)
+ 'SRTLIST: Edge:',ix,edges(1,ix),
+ edges(2,ix),dgp(ix)
enddo
info = psb_err_input_value_invalid_i_
@ -175,7 +178,8 @@ c$$$ write(0,*) 'SRTLIST Input :',i,ip
DO I=1, NP
IF (DG(I).NE.0) THEN
WRITE(0,*) 'SRTLIST Error on exit:',i,dg(i)
write(psb_err_unit,*)
+ 'SRTLIST Error on exit:',i,dg(i)
ENDIF
DG(I) = 0
ENDDO
@ -189,14 +193,17 @@ c$$$ write(0,*) 'SRTLIST Input :',i,ip
ENDDO
DO I=1, NP
IF (DG(I).NE.LDL(I)) THEN
WRITE(0,*) 'SRTLIST Mismatch on output',i,dg(i),ldl(i)
write(psb_err_unit,*)
+ 'SRTLIST Mismatch on output',i,dg(i),ldl(i)
ENDIF
ENDDO
c$$$ WRITE(0,*) 'Output communication:',t2-t1
c$$$ write(psb_err_unit,*)
c$$$ 'Output communication:',t2-t1
c$$$ do i=1,np
c$$$ do j=1,ldl(i)
c$$$ write(0,*)'SRTLIST', i,dep_list(j,i)+1
c$$$ write(psb_err_unit,*)
c$$$ 'SRTLIST', i,dep_list(j,i)+1
c$$$ enddo
c$$$ enddo

4
base/modules/psb_base_mat_mod.f03
Unescape Escape View File

@ -247,7 +247,7 @@ contains
class(psb_base_sparse_mat), intent(inout) :: a
integer, intent(in) :: v(:)
! TBD
write(0,*) 'SET_AUX is empty right now '
write(psb_err_unit,*) 'SET_AUX is empty right now '
end subroutine psb_base_set_aux
subroutine psb_base_get_aux(v,a)
@ -255,7 +255,7 @@ contains
class(psb_base_sparse_mat), intent(in) :: a
integer, intent(out), allocatable :: v(:)
! TBD
write(0,*) 'GET_AUX is empty right now '
write(psb_err_unit,*) 'GET_AUX is empty right now '
end subroutine psb_base_get_aux
subroutine psb_base_set_nrows(m,a)

2
base/modules/psb_c_tools_mod.f90
Unescape Escape View File

@ -237,7 +237,7 @@ Module psb_c_tools_mod
!!$ call psb_cdcpy(descin,cd_xt,info)
!!$ if (info == psb_success_) call psb_cd_reinit(cd_xt,info)
!!$ if (info /= psb_success_) then
!!$ write(0,*) 'Error on reinitialising the extension map'
!!$ write(psb_err_unit,*) 'Error on reinitialising the extension map'
!!$ call psb_error(ictxt)
!!$ call psb_abort(ictxt)
!!$ stop

13
base/modules/psb_const_mod.F90
Unescape Escape View File

@ -31,6 +31,9 @@
!!$
module psb_const_mod
#if defined(HAVE_ISO_FORTRAN_ENV)
use iso_fortran_env
#endif
! This is the default integer
#if defined(LONG_INTEGERS)
integer, parameter :: ndig=12
@ -110,6 +113,16 @@ module psb_const_mod
integer, parameter :: psb_dbleint_=2
character(len=5) :: psb_fidef_='CSR'
#if defined(HAVE_ISO_FORTRAN_ENV)
integer, save :: psb_err_unit = error_unit
integer, save :: psb_inp_unit = input_unit
integer, save :: psb_out_unit = output_unit
#else
integer, save :: psb_err_unit = 0
integer, save :: psb_inp_unit = 5
integer, save :: psb_out_unit = 6
#endif
!
!
! Error constants

2
base/modules/psb_d_tools_mod.f90
Unescape Escape View File

@ -236,7 +236,7 @@ Module psb_d_tools_mod
!!$ call psb_cdcpy(descin,cd_xt,info)
!!$ if (info == psb_success_) call psb_cd_reinit(cd_xt,info)
!!$ if (info /= psb_success_) then
!!$ write(0,*) 'Error on reinitialising the extension map'
!!$ write(psb_err_unit,*) 'Error on reinitialising the extension map'
!!$ call psb_error(ictxt)
!!$ call psb_abort(ictxt)
!!$ stop

4
base/modules/psb_desc_type.f90
Unescape Escape View File

@ -680,7 +680,7 @@ contains
do
if (ip > size(idx)) then
write(0,*) trim(name),': Warning: out of size of input vector '
write(psb_err_unit,*) trim(name),': Warning: out of size of input vector '
exit
end if
if (idx(ip) == -1) exit
@ -1305,7 +1305,7 @@ contains
idxlist => desc%ext_index
case(psb_comm_mov_)
idxlist => desc%ovr_mst_idx
write(0,*) 'Warning: unusual request getidx on ovr_mst_idx'
write(psb_err_unit,*) 'Warning: unusual request getidx on ovr_mst_idx'
case default
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='wrong Data selector')

8
base/modules/psb_error_impl.F90
Unescape Escape View File

@ -24,10 +24,10 @@ subroutine psb_serror()
if(psb_get_errverbosity() > 1) then
do while (psb_get_numerr() > izero)
write(0,'(50("="))')
write(psb_err_unit,'(50("="))')
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
call psb_errmsg(err_c, r_name, i_e_d, a_e_d)
! write(0,'(50("="))')
! write(psb_err_unit,'(50("="))')
end do
else
@ -71,10 +71,10 @@ subroutine psb_perror(ictxt)
if(psb_get_errverbosity() > 1) then
do while (psb_get_numerr() > izero)
write(0,'(50("="))')
write(psb_err_unit,'(50("="))')
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
call psb_errmsg(err_c, r_name, i_e_d, a_e_d,iam)
! write(0,'(50("="))')
! write(psb_err_unit,'(50("="))')
end do
#if defined(HAVE_FLUSH_STMT)
flush(0)

222
base/modules/psb_error_mod.F90
Unescape Escape View File

@ -99,8 +99,7 @@ module psb_error_mod
integer, save :: error_status=0 ! the error status (maybe not here)
integer, save :: verbosity_level=1 ! the verbosity level (maybe not here)
integer, save :: err_action=psb_act_abort_
integer, save :: debug_level=0, debug_unit=0, serial_debug_level=0
integer, save :: error_unit=0
integer, save :: debug_level=0, debug_unit, serial_debug_level=0
contains
@ -155,7 +154,8 @@ contains
subroutine psb_set_debug_unit(unit)
integer, intent(in) :: unit
if (unit >= 0) then
if ((unit >= 0).or.(unit == psb_err_unit)&
& .or.(unit == psb_out_unit)) then
debug_unit = unit
else
debug_unit = 0
@ -277,264 +277,264 @@ contains
integer, optional :: me
if(present(me)) then
write(error_unit,'("Process: ",i0,". PSBLAS Error (",i0,") in subroutine: ",a20)')&
write(psb_err_unit,'("Process: ",i0,". PSBLAS Error (",i0,") in subroutine: ",a20)')&
& me,err_c,trim(r_name)
else
write(error_unit,'("PSBLAS Error (",i0,") in subroutine: ",a)')err_c,trim(r_name)
write(psb_err_unit,'("PSBLAS Error (",i0,") in subroutine: ",a)')err_c,trim(r_name)
end if
select case (err_c)
case(:psb_success_)
write (error_unit,'("error on calling sperror. err_c must be greater than 0")')
write(psb_err_unit,'("error on calling sperror. err_c must be greater than 0")')
case(psb_err_pivot_too_small_)
write (error_unit,'("pivot too small: ",i0,1x,a)')i_e_d(1),trim(a_e_d)
write(psb_err_unit,'("pivot too small: ",i0,1x,a)')i_e_d(1),trim(a_e_d)
case(psb_err_invalid_ovr_num_)
write (error_unit,'("Invalid number of ovr:",i0)')i_e_d(1)
write(psb_err_unit,'("Invalid number of ovr:",i0)')i_e_d(1)
case(psb_err_invalid_input_)
write (error_unit,'("Invalid input")')
write(psb_err_unit,'("Invalid input")')
case(psb_err_iarg_neg_)
write (error_unit,'("input argument n. ",i0," cannot be less than 0")')i_e_d(1)
write (error_unit,'("current value is ",i0)')i_e_d(2)
write(psb_err_unit,'("input argument n. ",i0," cannot be less than 0")')i_e_d(1)
write(psb_err_unit,'("current value is ",i0)')i_e_d(2)
case(psb_err_iarg_pos_)
write (error_unit,'("input argument n. ",i0," cannot be greater than 0")')i_e_d(1)
write (error_unit,'("current value is ",i0)')i_e_d(2)
write(psb_err_unit,'("input argument n. ",i0," cannot be greater than 0")')i_e_d(1)
write(psb_err_unit,'("current value is ",i0)')i_e_d(2)
case(psb_err_input_value_invalid_i_)
write (error_unit,'("input argument n. ",i0," has an invalid value")')i_e_d(1)
write (error_unit,'("current value is ",i0)')i_e_d(2)
write(psb_err_unit,'("input argument n. ",i0," has an invalid value")')i_e_d(1)
write(psb_err_unit,'("current value is ",i0)')i_e_d(2)
case(psb_err_input_asize_invalid_i_)
write (error_unit,'("Size of input array argument n. ",i0," is invalid.")')i_e_d(1)
write (error_unit,'("Current value is ",i0)')i_e_d(2)
write(psb_err_unit,'("Size of input array argument n. ",i0," is invalid.")')i_e_d(1)
write(psb_err_unit,'("Current value is ",i0)')i_e_d(2)
case(psb_err_input_asize_small_i_)
write (error_unit,'("Size of input array argument n. ",i0," is too small.")')i_e_d(1)
write (error_unit,'("Current value is ",i0," Should be at least ",i0)') i_e_d(2),i_e_d(3)
write(psb_err_unit,'("Size of input array argument n. ",i0," is too small.")')i_e_d(1)
write(psb_err_unit,'("Current value is ",i0," Should be at least ",i0)') i_e_d(2),i_e_d(3)
case(psb_err_iarg_invalid_i_)
write (error_unit,'("input argument n. ",i0," has an invalid value")')i_e_d(1)
write (error_unit,'("current value is ",a)')a_e_d(2:2)
write(psb_err_unit,'("input argument n. ",i0," has an invalid value")')i_e_d(1)
write(psb_err_unit,'("current value is ",a)')a_e_d(2:2)
case(psb_err_iarg_not_gtia_ii_)
write (error_unit,'("input argument n. ",i0," must be equal or greater than input argument n. ",i0)') &
write(psb_err_unit,'("input argument n. ",i0," must be equal or greater than input argument n. ",i0)') &
& i_e_d(1), i_e_d(3)
write (error_unit,'("current values are ",i0," < ",i0)')&
write(psb_err_unit,'("current values are ",i0," < ",i0)')&
& i_e_d(2),i_e_d(5)
case(psb_err_iarg_not_gteia_ii_)
write (error_unit,'("input argument n. ",i0," must be greater than or equal to ",i0)')&
write(psb_err_unit,'("input argument n. ",i0," must be greater than or equal to ",i0)')&
& i_e_d(1),i_e_d(2)
write (error_unit,'("current value is ",i0," < ",i0)')&
write(psb_err_unit,'("current value is ",i0," < ",i0)')&
& i_e_d(3), i_e_d(2)
case(psb_err_iarg_invalid_value_)
write (error_unit,'("input argument n. ",i0," in entry # ",i0," has an invalid value")')&
write(psb_err_unit,'("input argument n. ",i0," in entry # ",i0," has an invalid value")')&
& i_e_d(1:2)
write (error_unit,'("current value is ",a)')trim(a_e_d)
write(psb_err_unit,'("current value is ",a)')trim(a_e_d)
case(psb_err_asb_nrc_error_)
write (error_unit,'("Impossible error in ASB: nrow>ncol,")')
write (error_unit,'("Actual values are ",i0," > ",i0)')i_e_d(1:2)
write(psb_err_unit,'("Impossible error in ASB: nrow>ncol,")')
write(psb_err_unit,'("Actual values are ",i0," > ",i0)')i_e_d(1:2)
! ... csr format error ...
case(psb_err_iarg2_neg_)
write (error_unit,'("input argument ia2(1) is less than 0")')
write (error_unit,'("current value is ",i0)')i_e_d(1)
write(psb_err_unit,'("input argument ia2(1) is less than 0")')
write(psb_err_unit,'("current value is ",i0)')i_e_d(1)
! ... csr format error ...
case(psb_err_ia2_not_increasing_)
write (error_unit,'("indices in ia2 array are not in increasing order")')
write(psb_err_unit,'("indices in ia2 array are not in increasing order")')
case(psb_err_ia1_not_increasing_)
write (error_unit,'("indices in ia1 array are not in increasing order")')
write(psb_err_unit,'("indices in ia1 array are not in increasing order")')
! ... csr format error ...
case(psb_err_ia1_badindices_)
write (error_unit,'("indices in ia1 array are not within problem dimension")')
write (error_unit,'("problem dimension is ",i0)')i_e_d(1)
write(psb_err_unit,'("indices in ia1 array are not within problem dimension")')
write(psb_err_unit,'("problem dimension is ",i0)')i_e_d(1)
case(psb_err_invalid_args_combination_)
write (error_unit,'("invalid combination of input arguments")')
write(psb_err_unit,'("invalid combination of input arguments")')
case(psb_err_invalid_pid_arg_)
write (error_unit,'("Invalid process identifier in input array argument n. ",i0,".")')&
write(psb_err_unit,'("Invalid process identifier in input array argument n. ",i0,".")')&
& i_e_d(1)
write (error_unit,'("Current value is ",i0)')i_e_d(2)
write(psb_err_unit,'("Current value is ",i0)')i_e_d(2)
case(psb_err_iarg_n_mbgtian_)
write (error_unit,'("input argument n. ",i0," must be greater than input argument n. ",i0)')&
write(psb_err_unit,'("input argument n. ",i0," must be greater than input argument n. ",i0)')&
& i_e_d(1:2)
write (error_unit,'("current values are ",i0," < ",i0)') i_e_d(3:4)
write(psb_err_unit,'("current values are ",i0," < ",i0)') i_e_d(3:4)
case(psb_err_dupl_cd_vl)
write (error_unit,'("there are duplicated entries in vl (input to cdall)")')
write(psb_err_unit,'("there are duplicated entries in vl (input to cdall)")')
! ... coo format error ...
! ... coo format error ...
case(psb_err_duplicate_coo)
write (error_unit,'("there are duplicated elements in coo format")')
write (error_unit,'("and you have chosen psb_dupl_err_ ")')
write(psb_err_unit,'("there are duplicated elements in coo format")')
write(psb_err_unit,'("and you have chosen psb_dupl_err_ ")')
case(psb_err_invalid_input_format_)
write (error_unit,'("Invalid input format ",a3)')&
write(psb_err_unit,'("Invalid input format ",a3)')&
& a_e_d(1:3)
case(psb_err_unsupported_format_)
write (error_unit,'("Format ",a3," not yet supported here")')&
write(psb_err_unit,'("Format ",a3," not yet supported here")')&
&a_e_d(1:3)
case(psb_err_format_unknown_)
write (error_unit,'("Format ",a3," is unknown")')&
write(psb_err_unit,'("Format ",a3," is unknown")')&
& a_e_d(1:3)
case(psb_err_iarray_outside_bounds_)
write (error_unit,'("indices in input array are not within problem dimension ",2(i0,2x))')&
write(psb_err_unit,'("indices in input array are not within problem dimension ",2(i0,2x))')&
&i_e_d(1:2)
case(psb_err_iarray_outside_process_)
write (error_unit,'("indices in input array are not belonging to the calling process ",i0)')&
write(psb_err_unit,'("indices in input array are not belonging to the calling process ",i0)')&
& i_e_d(1)
case(psb_err_forgot_geall_)
write (error_unit,'("To call this routine you must first call psb_geall on the same matrix")')
write(psb_err_unit,'("To call this routine you must first call psb_geall on the same matrix")')
case(psb_err_forgot_spall_)
write (error_unit,'("To call this routine you must first call psb_spall on the same matrix")')
write(psb_err_unit,'("To call this routine you must first call psb_spall on the same matrix")')
case(psb_err_wrong_ins_)
write (0,'("Something went wrong before this call to ",a,", probably in cdins/spins")')&
write(0,'("Something went wrong before this call to ",a,", probably in cdins/spins")')&
& trim(r_name)
case(psb_err_iarg_mbeeiarra_i_)
write (error_unit,&
write(psb_err_unit,&
& '("Input argument n. ",i0," must be equal to entry n. ",i0," in array input argument n.",i0)') &
& i_e_d(1),i_e_d(4),i_e_d(3)
write (error_unit,'("Current values are ",i0," != ",i0)')i_e_d(2), i_e_d(5)
write(psb_err_unit,'("Current values are ",i0," != ",i0)')i_e_d(2), i_e_d(5)
case(psb_err_mpi_error_)
write (error_unit,'("MPI error:",i0)')i_e_d(1)
write(psb_err_unit,'("MPI error:",i0)')i_e_d(1)
case(psb_err_parm_differs_among_procs_)
write (error_unit,'("Parameter n. ",i0," must be equal on all processes. ",i0)')i_e_d(1)
write(psb_err_unit,'("Parameter n. ",i0," must be equal on all processes. ",i0)')i_e_d(1)
case(psb_err_entry_out_of_bounds_)
write (error_unit,'("Entry n. ",i0," out of ",i0," should be between 1 and ",i0," but is ",i0)')&
write(psb_err_unit,'("Entry n. ",i0," out of ",i0," should be between 1 and ",i0," but is ",i0)')&
& i_e_d(1),i_e_d(3),i_e_d(4),i_e_d(2)
case(psb_err_inconsistent_index_lists_)
write (error_unit,'("Index lists are inconsistent: some indices are orphans")')
write(psb_err_unit,'("Index lists are inconsistent: some indices are orphans")')
case(psb_err_partfunc_toomuchprocs_)
write (error_unit,&
write(psb_err_unit,&
&'("partition function passed as input argument n. ",i0," returns number of processes")')&
&i_e_d(1)
write (error_unit,&
write(psb_err_unit,&
& '("greater than No of grid s processes on global point ",i0,". Actual number of grid s ")')&
&i_e_d(4)
write (error_unit,'("processes is ",i0,", number returned is ",i0)')i_e_d(2),i_e_d(3)
write(psb_err_unit,'("processes is ",i0,", number returned is ",i0)')i_e_d(2),i_e_d(3)
case(psb_err_partfunc_toofewprocs_)
write (error_unit,'("partition function passed as input argument n. ",i0," returns number of processes")')&
write(psb_err_unit,'("partition function passed as input argument n. ",i0," returns number of processes")')&
&i_e_d(1)
write (error_unit,'("less or equal to 0 on global point ",i0,". Number returned is ",i0)')&
write(psb_err_unit,'("less or equal to 0 on global point ",i0,". Number returned is ",i0)')&
&i_e_d(3),i_e_d(2)
case(psb_err_partfunc_wrong_pid_)
write (error_unit,&
write(psb_err_unit,&
&'("partition function passed as input argument n. ",i0," returns wrong processes identifier")')&
& i_e_d(1)
write (error_unit,'("on global point ",i0,". Current value returned is : ",i0)')&
write(psb_err_unit,'("on global point ",i0,". Current value returned is : ",i0)')&
& i_e_d(3),i_e_d(2)
case(psb_err_no_optional_arg_)
write (error_unit,'("One of the optional arguments ",a," must be present")')&
write(psb_err_unit,'("One of the optional arguments ",a," must be present")')&
& trim(a_e_d)
case(psb_err_arg_m_required_)
write (error_unit,'("Argument M is required when argument PARTS is specified")')
write(psb_err_unit,'("Argument M is required when argument PARTS is specified")')
case(psb_err_spmat_invalid_state_)
write (error_unit,&
write(psb_err_unit,&
& '("Sparse Matrix and descriptors are in an invalid state for this subroutine call: ",i0)')&
&i_e_d(1)
case(psb_err_missing_override_method_)
write (error_unit,&
write(psb_err_unit,&
& '("Base class method ",a," called: the class for ",a," is missing an overriding implementation")')&
& trim(r_name), trim(a_e_d)
case (psb_err_invalid_cd_state_)
write (error_unit,'("Invalid state for communication descriptor")')
write(psb_err_unit,'("Invalid state for communication descriptor")')
case (psb_err_invalid_a_and_cd_state_)
write (error_unit,'("Invalid combined state for A and DESC_A")')
write(psb_err_unit,'("Invalid combined state for A and DESC_A")')
case(1124:1999)
write (error_unit,'("computational error. code: ",i0)')err_c
write(psb_err_unit,'("computational error. code: ",i0)')err_c
case(psb_err_context_error_)
write (0,'("Parallel context error. Number of processes=-1")')
write(0,'("Parallel context error. Number of processes=-1")')
case(psb_err_initerror_neugh_procs_)
write (error_unit,&
write(psb_err_unit,&
& '("Initialization error: not enough processes available in the parallel environment")')
case(psb_err_invalid_matrix_input_state_)
write (error_unit,'("Invalid input state for matrix.")')
write(psb_err_unit,'("Invalid input state for matrix.")')
case(psb_err_input_no_regen_)
write (error_unit,'("Input state for matrix is not adequate for regeneration.")')
write(psb_err_unit,'("Input state for matrix is not adequate for regeneration.")')
case (2233:2999)
write(error_unit,'("resource error. code: ",i0)')err_c
write(psb_err_unit,'("resource error. code: ",i0)')err_c
case(3000:3009)
write (error_unit,&
write(psb_err_unit,&
& '("sparse matrix representation ",a3," not yet implemented")')&
&a_e_d(1:3)
case(psb_err_lld_case_not_implemented_)
write (error_unit,&
write(psb_err_unit,&
&'("Case lld not equal matrix_data[N_COL_] is not yet implemented.")')
case(psb_err_transpose_unsupported_)
write (error_unit,&
write(psb_err_unit,&
& '("transpose option for sparse matrix representation ",a3," not implemented")')&
& a_e_d(1:3)
case(psb_err_transpose_c_unsupported_)
write (error_unit,'("Case trans = C is not yet implemented.")')
write(psb_err_unit,'("Case trans = C is not yet implemented.")')
case(psb_err_transpose_not_n_unsupported_)
write (error_unit,'("Case trans /= N is not yet implemented.")')
write(psb_err_unit,'("Case trans /= N is not yet implemented.")')
case(psb_err_only_unit_diag_)
write (error_unit,'("Only unit diagonal so far for triangular matrices. ")')
write(psb_err_unit,'("Only unit diagonal so far for triangular matrices. ")')
case(3023)
write (error_unit,'("Cases DESCRA(1:1)=S DESCRA(1:1)=T not yet implemented. ")')
write(psb_err_unit,'("Cases DESCRA(1:1)=S DESCRA(1:1)=T not yet implemented. ")')
case(3024)
write (error_unit,'("Cases DESCRA(1:1)=G not yet implemented. ")')
write(psb_err_unit,'("Cases DESCRA(1:1)=G not yet implemented. ")')
case(psb_err_ja_nix_ia_niy_unsupported_)
write (error_unit,'("Case ja /= ix or ia/=iy is not yet implemented.")')
write(psb_err_unit,'("Case ja /= ix or ia/=iy is not yet implemented.")')
case(psb_err_ix_n1_iy_n1_unsupported_)
write (error_unit,'("Case ix /= 1 or iy /= 1 is not yet implemented.")')
write(psb_err_unit,'("Case ix /= 1 or iy /= 1 is not yet implemented.")')
case(3050)
write (error_unit,'("Case ix /= iy is not yet implemented.")')
write(psb_err_unit,'("Case ix /= iy is not yet implemented.")')
case(3060)
write (error_unit,'("Case ix /= 1 is not yet implemented.")')
write(psb_err_unit,'("Case ix /= 1 is not yet implemented.")')
case(3070)
write (error_unit,&
write(psb_err_unit,&
& '("This operation is only implemented with no overlap.")')
case(3080)
write (error_unit,&
write(psb_err_unit,&
& '("Decompostion type ",i0," not yet supported.")')&
& i_e_d(1)
case(3090)
write (error_unit,'("Insert matrix mode not yet implemented.")')
write(psb_err_unit,'("Insert matrix mode not yet implemented.")')
case(3100)
write (error_unit,&
write(psb_err_unit,&
& '("Error on index. Element has not been inserted")')
write (error_unit,&
write(psb_err_unit,&
& '("local index is: ",i0," and global index is:",i0)')&
& i_e_d(1:2)
case(psb_err_input_matrix_unassembled_)
write (error_unit,&
write(psb_err_unit,&
&'("Before you call this routine, you must assembly sparse matrix")')
case(3111)
write (error_unit,&
write(psb_err_unit,&
& '("Before you call this routine, you must initialize the preconditioner")')
case(3112)
write (error_unit,&
write(psb_err_unit,&
& '("Before you call this routine, you must build the preconditioner")')
case(3113:3999)
write(error_unit,'("miscellaneus error. code: ",i0)')err_c
write(psb_err_unit,'("miscellaneus error. code: ",i0)')err_c
case(psb_err_alloc_dealloc_)
write(error_unit,'("Allocation/deallocation error")')
write(psb_err_unit,'("Allocation/deallocation error")')
case(psb_err_internal_error_)
write(error_unit,'("Internal error: ",a)') &
write(psb_err_unit,'("Internal error: ",a)') &
& trim(a_e_d)
case(psb_err_from_subroutine_)
write (error_unit,'("Error from call to subroutine ",a)')&
write(psb_err_unit,'("Error from call to subroutine ",a)')&
& trim(a_e_d)
case(psb_err_from_subroutine_non_)
write (error_unit,'("Error from call to a subroutine ")')
write(psb_err_unit,'("Error from call to a subroutine ")')
case(psb_err_from_subroutine_i_)
write (error_unit,'("Error ",i0," from call to a subroutine ")')&
write(psb_err_unit,'("Error ",i0," from call to a subroutine ")')&
& i_e_d(1)
case(psb_err_from_subroutine_ai_)
write (error_unit,'("Error from call to subroutine ",a," ",i0)')&
write(psb_err_unit,'("Error from call to subroutine ",a," ",i0)')&
& trim(a_e_d),i_e_d(1)
case(psb_err_alloc_request_)
write (error_unit,&
write(psb_err_unit,&
& '("Error on allocation request for ",i0," items of type ",a)')&
& i_e_d(1),trim(a_e_d)
case(4110)
write (error_unit,&
write(psb_err_unit,&
& '("Error ",i0," from call to an external package in subroutine ",a)')&
&i_e_d(1),trim(a_e_d)
case (psb_err_invalid_istop_)
write (error_unit,'("Invalid ISTOP: ",i0)')i_e_d(1)
write(psb_err_unit,'("Invalid ISTOP: ",i0)')i_e_d(1)
case (5002)
write (error_unit,'("Invalid PREC: ",i0)')i_e_d(1)
write(psb_err_unit,'("Invalid PREC: ",i0)')i_e_d(1)
case (5003)
write (error_unit,'("Invalid PREC: ",a3)')a_e_d(1:3)
write(psb_err_unit,'("Invalid PREC: ",a3)')a_e_d(1:3)
case default
write(error_unit,'("unknown error (",i0,") in subroutine ",a)')&
write(psb_err_unit,'("unknown error (",i0,") in subroutine ",a)')&
& err_c,trim(r_name)
write(error_unit,'(5(i0,2x))') i_e_d
write(error_unit,'(a)') trim(a_e_d)
write(psb_err_unit,'(5(i0,2x))') i_e_d
write(psb_err_unit,'(a)') trim(a_e_d)
end select

24
base/modules/psb_gps_mod.f90
Unescape Escape View File

@ -123,13 +123,13 @@ CONTAINS
ALLOCATE(SIZEG(NR),STPT(NR), STAT=INFO)
IF(INFO /= psb_success_) THEN
WRITE(*,*) 'ERROR! MEMORY ALLOCATION # 1 FAILED IN GPS'
write(psb_out_unit,*) 'ERROR! MEMORY ALLOCATION # 1 FAILED IN GPS'
STOP
END IF
!
ALLOCATE(NHIGH(INIT), NLOW(INIT), NACUM(INIT), AUX(INIT), STAT=INFO)
IF(INFO /= psb_success_) THEN
WRITE(*,*) 'ERROR! MEMORY ALLOCATION # 2 FAILED IN GPS'
write(psb_out_unit,*) 'ERROR! MEMORY ALLOCATION # 2 FAILED IN GPS'
STOP
END IF
!
@ -405,7 +405,7 @@ CONTAINS
!-----------------------------------------------------
SZ=SIZE(NACUM)
IF(SZ < IDPTH) THEN
WRITE(*,*) 'GPS_SETUP: on fly reallocation of NACUM'
write(psb_out_unit,*) 'GPS_SETUP: on fly reallocation of NACUM'
CALL REALLOC(NACUM,SZ,IDPTH)
END IF
!-----------------------------------------------------
@ -485,12 +485,12 @@ CONTAINS
!-----------------------------------------------------
SZ=SIZE(NHIGH)
IF(SZ < IDPTH) THEN
WRITE(*,*) 'GPS_PIKLVL: on fly reallocation of NHIGH'
write(psb_out_unit,*) 'GPS_PIKLVL: on fly reallocation of NHIGH'
CALL REALLOC(NHIGH,SZ,IDPTH)
END IF
SZ=SIZE(NLOW)
IF(SZ < IDPTH) THEN
WRITE(*,*) 'GPS_PIKLVL: on fly reallocation of NLOW'
write(psb_out_unit,*) 'GPS_PIKLVL: on fly reallocation of NLOW'
CALL REALLOC(NLOW,SZ,IDPTH)
END IF
!-----------------------------------------------------
@ -637,7 +637,7 @@ CONTAINS
SZ1=SIZE(STKC)
SZ2=XC+XA
IF(SZ1 < SZ2) THEN
WRITE(*,*) 'GPS_NUMBER - Check #1: on fly reallocation of STKC'
write(psb_out_unit,*) 'GPS_NUMBER - Check #1: on fly reallocation of STKC'
CALL REALLOC(NACUM,SZ1,SZ2)
STKC => NACUM
END IF
@ -649,7 +649,7 @@ CONTAINS
SZ1=SIZE(STKC)
SZ2=XC
IF(SZ1 < SZ2) THEN
WRITE(*,*) 'GPS_NUMBER - Check #2: on fly reallocation of STKC'
write(psb_out_unit,*) 'GPS_NUMBER - Check #2: on fly reallocation of STKC'
SZ2=SZ2+INIT
CALL REALLOC(NACUM,SZ1,SZ2)
STKC => NACUM
@ -662,7 +662,7 @@ CONTAINS
SZ1=SIZE(STKD)
SZ2=XD+XB
IF(SZ1 < SZ2) THEN
WRITE(*,*) 'GPS_NUMBER - Check #3: on fly reallocation of STKD'
write(psb_out_unit,*) 'GPS_NUMBER - Check #3: on fly reallocation of STKD'
CALL REALLOC(AUX,SZ1,SZ2)
STKD => AUX
END IF
@ -674,7 +674,7 @@ CONTAINS
SZ1=SIZE(STKD)
SZ2=XD
IF(SZ1 < SZ2) THEN
WRITE(*,*) 'GPS_NUMBER - Check #4: on fly reallocation of STKD'
write(psb_out_unit,*) 'GPS_NUMBER - Check #4: on fly reallocation of STKD'
SZ2=SZ2+INIT
CALL REALLOC(AUX,SZ1,SZ2)
STKD => AUX
@ -703,7 +703,7 @@ CONTAINS
SZ1=SIZE(STKC)
SZ2=XC
IF(SZ1 < SZ2) THEN
WRITE(*,*) 'GPS_NUMBER - Check #5: on fly reallocation of STKC'
write(psb_out_unit,*) 'GPS_NUMBER - Check #5: on fly reallocation of STKC'
SZ2=SZ2+INIT
CALL REALLOC(NACUM,SZ1,SZ2)
STKC => NACUM
@ -718,7 +718,7 @@ CONTAINS
SZ1=SIZE(STKC)
SZ2=XD
IF(SZ1 < SZ2) THEN
WRITE(*,*) 'GPS_NUMBER - Check #6: on fly reallocation of STKC'
write(psb_out_unit,*) 'GPS_NUMBER - Check #6: on fly reallocation of STKC'
SZ2=SZ2+INIT
CALL REALLOC(NACUM,SZ1,SZ2)
STKC => NACUM
@ -748,7 +748,7 @@ CONTAINS
call psb_realloc(sz2,vet,info)
IF(INFO /= psb_success_) THEN
WRITE(*,*) 'Error! Memory allocation failure in REALLOC'
write(psb_out_unit,*) 'Error! Memory allocation failure in REALLOC'
STOP
END IF
RETURN

6
base/modules/psb_hash_mod.f90
Unescape Escape View File

@ -201,7 +201,7 @@ contains
do i=1,nv
call psb_hash_searchinskey(v(i),j,i,hash,info)
if ((j /= i).or.(info /= HashOK)) then
write(0,*) 'Error from hash_ins',i,v(i),j,info
write(psb_err_unit,*) 'Error from hash_ins',i,v(i),j,info
info = HashNotFound
return
end if
@ -223,7 +223,7 @@ contains
!
do
if (hsize < 0) then
write(0,*) 'Error: hash size overflow ',hsize,nbits
write(psb_err_unit,*) 'Error: hash size overflow ',hsize,nbits
info = -2
return
end if
@ -239,7 +239,7 @@ contains
hash%nacc = 0
allocate(hash%table(0:hsize-1,2),stat=info)
if (info /= psb_success_) then
write(0,*) 'Error: memory allocation failure ',hsize
write(psb_err_unit,*) 'Error: memory allocation failure ',hsize
info = HashOutOfMemory
return
end if

40
base/modules/psb_realloc_mod.F90
Unescape Escape View File

@ -1667,9 +1667,9 @@ Contains
call psb_erractionsave(err_act)
info=psb_success_
if (debug) write(0,*) 'reallocate I',len
if (debug) write(psb_err_unit,*) 'reallocate I',len
if (psb_get_errstatus() /= 0) then
if (debug) write(0,*) 'reallocate errstatus /= 0'
if (debug) write(psb_err_unit,*) 'reallocate errstatus /= 0'
info=psb_err_from_subroutine_
goto 9999
end if
@ -1685,7 +1685,7 @@ Contains
goto 9999
end if
ub_ = lb_+len-1
if (debug) write(0,*) 'reallocate : lb ub ',lb_, ub_
if (debug) write(psb_err_unit,*) 'reallocate : lb ub ',lb_, ub_
if (allocated(rrax)) then
dim = size(rrax)
lbi = lbound(rrax,1)
@ -1697,9 +1697,9 @@ Contains
goto 9999
end if
tmp(lb_:lb_-1+min(len,dim))=rrax(lbi:lbi-1+min(len,dim))
if (debug) write(0,*) 'reallocate : calling move_alloc '
if (debug) write(psb_err_unit,*) 'reallocate : calling move_alloc '
call psb_move_alloc(tmp,rrax,info)
if (debug) write(0,*) 'reallocate : from move_alloc ',info
if (debug) write(psb_err_unit,*) 'reallocate : from move_alloc ',info
end if
else
dim = 0
@ -1713,7 +1713,7 @@ Contains
if (present(pad)) then
rrax(lb_-1+dim+1:lb_-1+len) = pad
endif
if (debug) write(0,*) 'end reallocate : ',info
if (debug) write(psb_err_unit,*) 'end reallocate : ',info
call psb_erractionrestore(err_act)
return
@ -1750,9 +1750,9 @@ Contains
call psb_erractionsave(err_act)
info=psb_success_
if (debug) write(0,*) 'reallocate I',len
if (debug) write(psb_err_unit,*) 'reallocate I',len
if (psb_get_errstatus() /= 0) then
if (debug) write(0,*) 'reallocate errstatus /= 0'
if (debug) write(psb_err_unit,*) 'reallocate errstatus /= 0'
info=psb_err_from_subroutine_
goto 9999
end if
@ -1768,7 +1768,7 @@ Contains
goto 9999
end if
ub_ = lb_+len-1
if (debug) write(0,*) 'reallocate : lb ub ',lb_, ub_
if (debug) write(psb_err_unit,*) 'reallocate : lb ub ',lb_, ub_
if (allocated(rrax)) then
dim = size(rrax)
lbi = lbound(rrax,1)
@ -1780,9 +1780,9 @@ Contains
goto 9999
end if
tmp(lb_:lb_-1+min(len,dim))=rrax(lbi:lbi-1+min(len,dim))
if (debug) write(0,*) 'reallocate : calling move_alloc '
if (debug) write(psb_err_unit,*) 'reallocate : calling move_alloc '
call psb_move_alloc(tmp,rrax,info)
if (debug) write(0,*) 'reallocate : from move_alloc ',info
if (debug) write(psb_err_unit,*) 'reallocate : from move_alloc ',info
end if
else
dim = 0
@ -1796,7 +1796,7 @@ Contains
if (present(pad)) then
rrax(lb_-1+dim+1:lb_-1+len) = pad
endif
if (debug) write(0,*) 'end reallocate : ',info
if (debug) write(psb_err_unit,*) 'end reallocate : ',info
call psb_erractionrestore(err_act)
return
@ -1834,7 +1834,7 @@ Contains
name='psb_reallocate1s'
call psb_erractionsave(err_act)
info=psb_success_
if (debug) write(0,*) 'reallocate S',len
if (debug) write(psb_err_unit,*) 'reallocate S',len
if (present(lb)) then
lb_ = lb
@ -1908,7 +1908,7 @@ Contains
name='psb_reallocate1d'
call psb_erractionsave(err_act)
info=psb_success_
if (debug) write(0,*) 'reallocate D',len
if (debug) write(psb_err_unit,*) 'reallocate D',len
if (present(lb)) then
lb_ = lb
@ -1983,7 +1983,7 @@ Contains
name='psb_reallocate1c'
call psb_erractionsave(err_act)
info=psb_success_
if (debug) write(0,*) 'reallocate C',len
if (debug) write(psb_err_unit,*) 'reallocate C',len
if (present(lb)) then
lb_ = lb
else
@ -2056,7 +2056,7 @@ Contains
name='psb_reallocate1z'
call psb_erractionsave(err_act)
info=psb_success_
if (debug) write(0,*) 'reallocate Z',len
if (debug) write(psb_err_unit,*) 'reallocate Z',len
if (present(lb)) then
lb_ = lb
else
@ -2916,7 +2916,7 @@ Contains
if (allocated(vin)) then
call move_alloc(vin,vout)
else if (allocated(vout)) then
!!$ write(0,*) 'move_alloc: Clearing output'
!!$ write(psb_err_unit,*) 'move_alloc: Clearing output'
deallocate(vout)
end if
@ -2971,7 +2971,7 @@ Contains
if (allocated(vin)) then
call move_alloc(vin,vout)
else if (allocated(vout)) then
!!$ write(0,*) 'move_alloc: Clearing output'
!!$ write(psb_err_unit,*) 'move_alloc: Clearing output'
deallocate(vout)
end if
@ -3129,7 +3129,7 @@ Contains
if (allocated(vin)) then
call move_alloc(vin,vout)
else if (allocated(vout)) then
!!$ write(0,*) 'move_alloc: Clearing output'
!!$ write(psb_err_unit,*) 'move_alloc: Clearing output'
deallocate(vout)
end if
#else
@ -3183,7 +3183,7 @@ Contains
if (allocated(vin)) then
call move_alloc(vin,vout)
else if (allocated(vout)) then
!!$ write(0,*) 'move_alloc: Clearing output'
!!$ write(psb_err_unit,*) 'move_alloc: Clearing output'
deallocate(vout)
end if
#else

2
base/modules/psb_s_tools_mod.f90
Unescape Escape View File

@ -238,7 +238,7 @@ Module psb_s_tools_mod
!!$ call psb_cdcpy(descin,cd_xt,info)
!!$ if (info == psb_success_) call psb_cd_reinit(cd_xt,info)
!!$ if (info /= psb_success_) then
!!$ write(0,*) 'Error on reinitialising the extension map'
!!$ write(psb_err_unit,*) 'Error on reinitialising the extension map'
!!$ call psb_error(ictxt)
!!$ call psb_abort(ictxt)
!!$ stop

2
base/modules/psb_z_tools_mod.f90
Unescape Escape View File

@ -239,7 +239,7 @@ Module psb_z_tools_mod
!!$ call psb_cdcpy(descin,cd_xt,info)
!!$ if (info == psb_success_) call psb_cd_reinit(cd_xt,info)
!!$ if (info /= psb_success_) then
!!$ write(0,*) 'Error on reinitialising the extension map'
!!$ write(psb_err_unit,*) 'Error on reinitialising the extension map'
!!$ call psb_error(ictxt)
!!$ call psb_abort(ictxt)
!!$ stop

34
base/modules/psi_comm_buffers_mod.F90
Unescape Escape View File

@ -83,7 +83,7 @@ contains
! If we are here one is associated, the other is not.
! This is impossible.
info = -1
write(0,*) 'Wrong status on init '
write(psb_err_unit,*) 'Wrong status on init '
return
end if
@ -234,14 +234,14 @@ contains
allocate(node, stat=info)
if (info /= 0) then
write(0,*) 'Fatal memory error inside communication subsystem'
write(psb_err_unit,*) 'Fatal memory error inside communication subsystem'
return
end if
node%icontxt = icontxt
node%buffer_type = psb_int_type
call move_alloc(buffer,node%intbuf)
if (info /= 0) then
write(0,*) 'Fatal memory error inside communication subsystem'
write(psb_err_unit,*) 'Fatal memory error inside communication subsystem'
return
end if
call mpi_isend(node%intbuf,size(node%intbuf),psb_mpi_integer,&
@ -269,14 +269,14 @@ contains
allocate(node, stat=info)
if (info /= 0) then
write(0,*) 'Fatal memory error inside communication subsystem'
write(psb_err_unit,*) 'Fatal memory error inside communication subsystem'
return
end if
node%icontxt = icontxt
node%buffer_type = psb_int8_type
call move_alloc(buffer,node%int8buf)
if (info /= 0) then
write(0,*) 'Fatal memory error inside communication subsystem'
write(psb_err_unit,*) 'Fatal memory error inside communication subsystem'
return
end if
call mpi_isend(node%int8buf,size(node%int8buf),mpi_integer8,&
@ -305,14 +305,14 @@ contains
allocate(node, stat=info)
if (info /= 0) then
write(0,*) 'Fatal memory error inside communication subsystem'
write(psb_err_unit,*) 'Fatal memory error inside communication subsystem'
return
end if
node%icontxt = icontxt
node%buffer_type = psb_real_type
call move_alloc(buffer,node%realbuf)
if (info /= 0) then
write(0,*) 'Fatal memory error inside communication subsystem'
write(psb_err_unit,*) 'Fatal memory error inside communication subsystem'
return
end if
call mpi_isend(node%realbuf,size(node%realbuf),mpi_real,&
@ -339,14 +339,14 @@ contains
allocate(node, stat=info)
if (info /= 0) then
write(0,*) 'Fatal memory error inside communication subsystem'
write(psb_err_unit,*) 'Fatal memory error inside communication subsystem'
return
end if
node%icontxt = icontxt
node%buffer_type = psb_double_type
call move_alloc(buffer,node%doublebuf)
if (info /= 0) then
write(0,*) 'Fatal memory error inside communication subsystem'
write(psb_err_unit,*) 'Fatal memory error inside communication subsystem'
return
end if
call mpi_isend(node%doublebuf,size(node%doublebuf),mpi_double_precision,&
@ -373,14 +373,14 @@ contains
allocate(node, stat=info)
if (info /= 0) then
write(0,*) 'Fatal memory error inside communication subsystem'
write(psb_err_unit,*) 'Fatal memory error inside communication subsystem'
return
end if
node%icontxt = icontxt
node%buffer_type = psb_complex_type
call move_alloc(buffer,node%complexbuf)
if (info /= 0) then
write(0,*) 'Fatal memory error inside communication subsystem'
write(psb_err_unit,*) 'Fatal memory error inside communication subsystem'
return
end if
call mpi_isend(node%complexbuf,size(node%complexbuf),mpi_complex,&
@ -407,14 +407,14 @@ contains
allocate(node, stat=info)
if (info /= 0) then
write(0,*) 'Fatal memory error inside communication subsystem'
write(psb_err_unit,*) 'Fatal memory error inside communication subsystem'
return
end if
node%icontxt = icontxt
node%buffer_type = psb_dcomplex_type
call move_alloc(buffer,node%dcomplbuf)
if (info /= 0) then
write(0,*) 'Fatal memory error inside communication subsystem'
write(psb_err_unit,*) 'Fatal memory error inside communication subsystem'
return
end if
call mpi_isend(node%dcomplbuf,size(node%dcomplbuf),mpi_double_complex,&
@ -442,14 +442,14 @@ contains
allocate(node, stat=info)
if (info /= 0) then
write(0,*) 'Fatal memory error inside communication subsystem'
write(psb_err_unit,*) 'Fatal memory error inside communication subsystem'
return
end if
node%icontxt = icontxt
node%buffer_type = psb_logical_type
call move_alloc(buffer,node%logbuf)
if (info /= 0) then
write(0,*) 'Fatal memory error inside communication subsystem'
write(psb_err_unit,*) 'Fatal memory error inside communication subsystem'
return
end if
call mpi_isend(node%logbuf,size(node%logbuf),mpi_logical,&
@ -477,14 +477,14 @@ contains
allocate(node, stat=info)
if (info /= 0) then
write(0,*) 'Fatal memory error inside communication subsystem'
write(psb_err_unit,*) 'Fatal memory error inside communication subsystem'
return
end if
node%icontxt = icontxt
node%buffer_type = psb_char_type
call move_alloc(buffer,node%charbuf)
if (info /= 0) then
write(0,*) 'Fatal memory error inside communication subsystem'
write(psb_err_unit,*) 'Fatal memory error inside communication subsystem'
return
end if
call mpi_isend(node%charbuf,size(node%charbuf),mpi_character,&

14
base/modules/psi_p2p_mod.F90
Unescape Escape View File

@ -779,7 +779,7 @@ contains
call mpi_recv(dat,size(dat),psb_mpi_integer,src,psb_int_tag,ictxt,status,info)
end if
if (info /= mpi_success) then
write(0,*) 'Error in psb_recv', info
write(psb_err_unit,*) 'Error in psb_recv', info
end if
call psb_test_nodes(psb_mesg_queue)
#endif
@ -865,7 +865,7 @@ contains
call mpi_recv(dat,size(dat),mpi_real,src,psb_real_tag,ictxt,status,info)
end if
if (info /= mpi_success) then
write(0,*) 'Error in psb_recv', info
write(psb_err_unit,*) 'Error in psb_recv', info
end if
call psb_test_nodes(psb_mesg_queue)
#endif
@ -952,7 +952,7 @@ contains
& psb_double_tag,ictxt,status,info)
end if
if (info /= mpi_success) then
write(0,*) 'Error in psb_recv', info
write(psb_err_unit,*) 'Error in psb_recv', info
end if
call psb_test_nodes(psb_mesg_queue)
#endif
@ -1039,7 +1039,7 @@ contains
& psb_complex_tag,ictxt,status,info)
end if
if (info /= mpi_success) then
write(0,*) 'Error in psb_recv', info
write(psb_err_unit,*) 'Error in psb_recv', info
end if
call psb_test_nodes(psb_mesg_queue)
#endif
@ -1126,7 +1126,7 @@ contains
& psb_dcomplex_tag,ictxt,status,info)
end if
if (info /= mpi_success) then
write(0,*) 'Error in psb_recv', info
write(psb_err_unit,*) 'Error in psb_recv', info
end if
call psb_test_nodes(psb_mesg_queue)
#endif
@ -1211,7 +1211,7 @@ contains
& psb_logical_tag,ictxt,status,info)
end if
if (info /= mpi_success) then
write(0,*) 'Error in psb_recv', info
write(psb_err_unit,*) 'Error in psb_recv', info
end if
call psb_test_nodes(psb_mesg_queue)
#endif
@ -1328,7 +1328,7 @@ contains
& psb_int8_tag,ictxt,status,info)
end if
if (info /= mpi_success) then
write(0,*) 'Error in psb_recv', info
write(psb_err_unit,*) 'Error in psb_recv', info
end if
call psb_test_nodes(psb_mesg_queue)
#endif

11
base/modules/psi_penv_mod.F90
Unescape Escape View File

@ -133,6 +133,9 @@ contains
logical :: initialized
integer :: np_, npavail, iam, info, basecomm, basegroup, newgroup
character(len=20), parameter :: name='psb_init'
call psb_set_debug_unit(psb_err_unit)
#if defined(SERIAL_MPI)
ictxt = nctxt
nctxt = nctxt + 1
@ -145,7 +148,7 @@ contains
if ((.not.initialized).or.(info /= mpi_success)) then
call mpi_init(info)
if (info /= mpi_success) then
write(0,*) 'Error in initalizing MPI, bailing out',info
write(psb_err_unit,*) 'Error in initalizing MPI, bailing out',info
stop
end if
end if
@ -175,13 +178,13 @@ contains
call mpi_comm_group(basecomm,basegroup,info)
if (present(ids)) then
if (size(ids)<np) then
write(0,*) 'Error in init: too few ids in input'
write(psb_err_unit,*) 'Error in init: too few ids in input'
ictxt = mpi_comm_null
return
end if
do i=1, np
if ((ids(i)<0).or.(ids(i)>np_)) then
write(0,*) 'Error in init: invalid ransk in input'
write(psb_err_unit,*) 'Error in init: invalid rank in input'
ictxt = mpi_comm_null
return
end if
@ -438,7 +441,7 @@ contains
integer :: len,type
integer :: i
if (type /= mpi_integer8) then
write(0,*) 'Invalid type !!!'
write(psb_err_unit,*) 'Invalid type !!!'
end if
do i=1, len
if (abs(inv(i)) < abs(outv(i))) outv(i) = inv(i)

2
base/psblas/psb_sxdot.f90
Unescape Escape View File

@ -301,7 +301,7 @@ function sxdot(n,x,ix,y,iy)
integer :: i
if ((ix /= 1).or.(iy /= 1)) then
write(0,*) 'WARNING unimplemented case in SXDOT'
write(psb_err_unit,*) 'WARNING unimplemented case in SXDOT'
sxdot=dzero
return
end if

2
base/serial/aux/dasrx.f90
Unescape Escape View File

@ -58,7 +58,7 @@ subroutine dasrx(n,x,indx,dir,flag)
case(psb_sort_keep_idx_)
! do nothing
case default
write(0,*) 'Error in isrx: invalid flag',flag
write(psb_err_unit,*) 'Error in isrx: invalid flag',flag
end select
!

2
base/serial/aux/dmsr.f90
Unescape Escape View File

@ -47,7 +47,7 @@ subroutine dmsr(n,x,idir)
real(psb_dpk_) :: swap
if (n<0) then
!!$ write(0,*) 'Error: IMSR: N<0'
!!$ write(psb_err_unit,*) 'Error: IMSR: N<0'
return
endif

2
base/serial/aux/dmsrx.f90
Unescape Escape View File

@ -46,7 +46,7 @@ subroutine dmsrx(n,x,indx,idir,flag)
real(psb_dpk_) :: swap
if (n<0) then
!!$ write(0,*) 'Error: DMSRX: N<0'
!!$ write(psb_err_unit,*) 'Error: DMSRX: N<0'
return
endif

2
base/serial/aux/zamsr.f90
Unescape Escape View File

@ -47,7 +47,7 @@ subroutine zamsr(n,x,idir)
complex(psb_dpk_) :: swap
if (n<0) then
!!$ write(0,*) 'Error: IMSR: N<0'
!!$ write(psb_err_unit,*) 'Error: IMSR: N<0'
return
endif

4
base/serial/f03/psb_c_coo_impl.f03
Unescape Escape View File

@ -3089,7 +3089,7 @@ subroutine psb_c_fix_coo_inner(nzin,dupl,ia,ja,val,nzout,info,idir)
endif
enddo
case default
write(0,*) 'Error in fix_coo: unsafe dupl',dupl_
write(psb_err_unit,*) 'Error in fix_coo: unsafe dupl',dupl_
end select
@ -3173,7 +3173,7 @@ subroutine psb_c_fix_coo_inner(nzin,dupl,ia,ja,val,nzout,info,idir)
endif
enddo
case default
write(0,*) 'Error in fix_coo: unsafe dupl',dupl_
write(psb_err_unit,*) 'Error in fix_coo: unsafe dupl',dupl_
end select
if (debug_level >= psb_debug_serial_)&
& write(debug_unit,*) trim(name),': end second loop'

4
base/serial/f03/psb_c_mat_impl.f03
Unescape Escape View File

@ -1021,7 +1021,7 @@ subroutine psb_c_cscnv(a,b,info,type,mold,upd,dupl)
goto 9999
end if
if (debug) write(0,*) 'Converting from ',&
if (debug) write(psb_err_unit,*) 'Converting from ',&
& a%get_fmt(),' to ',altmp%get_fmt()
call altmp%cp_from_fmt(a%a, info)
@ -1117,7 +1117,7 @@ subroutine psb_c_cscnv_ip(a,info,type,mold,dupl)
goto 9999
end if
if (debug) write(0,*) 'Converting in-place from ',&
if (debug) write(psb_err_unit,*) 'Converting in-place from ',&
& a%get_fmt(),' to ',altmp%get_fmt()
call altmp%mv_from_fmt(a%a, info)

4
base/serial/f03/psb_d_coo_impl.f03
Unescape Escape View File

@ -3135,7 +3135,7 @@ subroutine psb_d_fix_coo_inner(nzin,dupl,ia,ja,val,nzout,info,idir)
endif
enddo
case default
write(0,*) 'Error in fix_coo: unsafe dupl',dupl_
write(psb_err_unit,*) 'Error in fix_coo: unsafe dupl',dupl_
end select
@ -3219,7 +3219,7 @@ subroutine psb_d_fix_coo_inner(nzin,dupl,ia,ja,val,nzout,info,idir)
endif
enddo
case default
write(0,*) 'Error in fix_coo: unsafe dupl',dupl_
write(psb_err_unit,*) 'Error in fix_coo: unsafe dupl',dupl_
end select
if (debug_level >= psb_debug_serial_)&
& write(debug_unit,*) trim(name),': end second loop'

4
base/serial/f03/psb_d_mat_impl.f03
Unescape Escape View File

@ -1021,7 +1021,7 @@ subroutine psb_d_cscnv(a,b,info,type,mold,upd,dupl)
goto 9999
end if
if (debug) write(0,*) 'Converting from ',&
if (debug) write(psb_err_unit,*) 'Converting from ',&
& a%get_fmt(),' to ',altmp%get_fmt()
call altmp%cp_from_fmt(a%a, info)
@ -1117,7 +1117,7 @@ subroutine psb_d_cscnv_ip(a,info,type,mold,dupl)
goto 9999
end if
if (debug) write(0,*) 'Converting in-place from ',&
if (debug) write(psb_err_unit,*) 'Converting in-place from ',&
& a%get_fmt(),' to ',altmp%get_fmt()
call altmp%mv_from_fmt(a%a, info)

4
base/serial/f03/psb_s_coo_impl.f03
Unescape Escape View File

@ -2888,7 +2888,7 @@ subroutine psb_s_fix_coo_inner(nzin,dupl,ia,ja,val,nzout,info,idir)
endif
enddo
case default
write(0,*) 'Error in fix_coo: unsafe dupl',dupl_
write(psb_err_unit,*) 'Error in fix_coo: unsafe dupl',dupl_
end select
@ -2972,7 +2972,7 @@ subroutine psb_s_fix_coo_inner(nzin,dupl,ia,ja,val,nzout,info,idir)
endif
enddo
case default
write(0,*) 'Error in fix_coo: unsafe dupl',dupl_
write(psb_err_unit,*) 'Error in fix_coo: unsafe dupl',dupl_
end select
if (debug_level >= psb_debug_serial_)&
& write(debug_unit,*) trim(name),': end second loop'

6
base/serial/f03/psb_s_mat_impl.f03
Unescape Escape View File

@ -619,7 +619,7 @@ subroutine psb_s_free(a)
implicit none
class(psb_s_sparse_mat), intent(inout) :: a
write(*,*) 'On entry to PSB_S_FREE: ',allocated(a%a)
write(psb_out_unit,*) 'On entry to PSB_S_FREE: ',allocated(a%a)
if (allocated(a%a)) then
call a%a%free()
deallocate(a%a)
@ -1022,7 +1022,7 @@ subroutine psb_s_cscnv(a,b,info,type,mold,upd,dupl)
goto 9999
end if
if (debug) write(0,*) 'Converting from ',&
if (debug) write(psb_err_unit,*) 'Converting from ',&
& a%get_fmt(),' to ',altmp%get_fmt()
call altmp%cp_from_fmt(a%a, info)
@ -1118,7 +1118,7 @@ subroutine psb_s_cscnv_ip(a,info,type,mold,dupl)
goto 9999
end if
if (debug) write(0,*) 'Converting in-place from ',&
if (debug) write(psb_err_unit,*) 'Converting in-place from ',&
& a%get_fmt(),' to ',altmp%get_fmt()
call altmp%mv_from_fmt(a%a, info)

4
base/serial/f03/psb_z_coo_impl.f03
Unescape Escape View File

@ -3088,7 +3088,7 @@ subroutine psb_z_fix_coo_inner(nzin,dupl,ia,ja,val,nzout,info,idir)
endif
enddo
case default
write(0,*) 'Error in fix_coo: unsafe dupl',dupl_
write(psb_err_unit,*) 'Error in fix_coo: unsafe dupl',dupl_
end select
@ -3172,7 +3172,7 @@ subroutine psb_z_fix_coo_inner(nzin,dupl,ia,ja,val,nzout,info,idir)
endif
enddo
case default
write(0,*) 'Error in fix_coo: unsafe dupl',dupl_
write(psb_err_unit,*) 'Error in fix_coo: unsafe dupl',dupl_
end select
if (debug_level >= psb_debug_serial_)&
& write(debug_unit,*) trim(name),': end second loop'

4
base/serial/f03/psb_z_mat_impl.f03
Unescape Escape View File

@ -1021,7 +1021,7 @@ subroutine psb_z_cscnv(a,b,info,type,mold,upd,dupl)
goto 9999
end if
if (debug) write(0,*) 'Converting from ',&
if (debug) write(psb_err_unit,*) 'Converting from ',&
& a%get_fmt(),' to ',altmp%get_fmt()
call altmp%cp_from_fmt(a%a, info)
@ -1117,7 +1117,7 @@ subroutine psb_z_cscnv_ip(a,info,type,mold,dupl)
goto 9999
end if
if (debug) write(0,*) 'Converting in-place from ',&
if (debug) write(psb_err_unit,*) 'Converting in-place from ',&
& a%get_fmt(),' to ',altmp%get_fmt()
call altmp%mv_from_fmt(a%a, info)

66
base/serial/f77/smmp.f
Unescape Escape View File

@ -42,10 +42,12 @@ c$$$ write(iunit,*) 'Row:',i,' : ',jb(ib(i):ib(i+1)-1)
c$$$ enddo
if (size(ic) < n+1) then
write(0,*) 'Called realloc in SYMBMM '
write(psb_err_unit,*)
+ 'Called realloc in SYMBMM '
call psb_realloc(n+1,ic,info)
if (info /= psb_success_) then
write(0,*) 'realloc failed in SYMBMM ',info
write(psb_err_unit,*)
+ 'realloc failed in SYMBMM ',info
end if
endif
maxlmn = max(l,m,n)
@ -63,7 +65,8 @@ c
c main loop
c
do 50 i=1,n
c$$$ write(0,*) 'SYMBMM: 1 loop ',i,n,ia(i),ia(i+1)
c$$$ write(psb_err_unit,*)
c$$$ 'SYMBMM: 1 loop ',i,n,ia(i),ia(i+1)
istart=-1
length=0
c
@ -84,11 +87,13 @@ c b = d + ...
length=length+1
endif
if ((j<1).or.(j>m)) then
write(0,*) ' SymbMM: Problem with A ',i,jj,j,m
write(psb_err_unit,*)
+ ' SymbMM: Problem with A ',i,jj,j,m
endif
do 20 k=ib(j),ib(j+1)-1
if ((jb(k)<1).or.(jb(k)>maxlmn)) then
write(0,*) 'Problem in SYMBMM 1:',j,k,jb(k),maxlmn
write(psb_err_unit,*)
+ 'Problem in SYMBMM 1:',j,k,jb(k),maxlmn
else
if(index(jb(k)).eq.0) then
index(jb(k))=istart
@ -128,7 +133,8 @@ c$$$ write(iunit,*) length,' : ',jc(ic(i):ic(i)+length-1)
50 continue
c$$$ close(iunit)
c$$$ iunit = iunit + 1
c$$$ write(0,*) 'SYMBMM: on exit',ic(n+1)-1,jc(ic(n+1)-1)
c$$$ write(psb_err_unit,*)
c$$$ 'SYMBMM: on exit',ic(n+1)-1,jc(ic(n+1)-1)
return
end
subroutine snumbmm(n, m, l,
@ -171,12 +177,14 @@ c b = d + ...
if (diagb.eq.1 .and. j.le.minlm)
* temp(j) = temp(j) + ajj * b(j)
if ((j<1).or.(j>m)) then
write(0,*) ' NUMBMM: Problem with A ',i,jj,j,m
write(psb_err_unit,*)
+ ' NUMBMM: Problem with A ',i,jj,j,m
endif
do 20 k = ib(j),ib(j+1)-1
if((jb(k)<1).or. (jb(k) > maxlmn)) then
write(0,*) ' NUMBMM: jb problem',j,k,jb(k),maxlmn
write(psb_err_unit,*)
+ ' NUMBMM: jb problem',j,k,jb(k),maxlmn
else
temp(jb(k)) = temp(jb(k)) + ajj * b(k)
endif
@ -188,10 +196,12 @@ c c = d + ...
temp(i) = 0.
endif
c$$$ if (mod(i,100) == 1)
c$$$ + write(0,*) ' NUMBMM: Fixing row ',i,ic(i),ic(i+1)-1
c$$$ + write(psb_err_unit,*)
c$$$ ' NUMBMM: Fixing row ',i,ic(i),ic(i+1)-1
do 40 j = ic(i),ic(i+1)-1
if((jc(j)<1).or. (jc(j) > maxlmn)) then
write(0,*) ' NUMBMM: output problem',i,j,jc(j),maxlmn
write(psb_err_unit,*)
+ ' NUMBMM: output problem',i,j,jc(j),maxlmn
else
c(j) = temp(jc(j))
temp(jc(j)) = 0.
@ -240,12 +250,14 @@ c b = d + ...
if (diagb.eq.1 .and. j.le.minlm)
* temp(j) = temp(j) + ajj * b(j)
if ((j<1).or.(j>m)) then
write(0,*) ' NUMBMM: Problem with A ',i,jj,j,m
write(psb_err_unit,*)
+ ' NUMBMM: Problem with A ',i,jj,j,m
endif
do 20 k = ib(j),ib(j+1)-1
if((jb(k)<1).or. (jb(k) > maxlmn)) then
write(0,*) ' NUMBMM: jb problem',j,k,jb(k),maxlmn
write(psb_err_unit,*)
+ ' NUMBMM: jb problem',j,k,jb(k),maxlmn
else
temp(jb(k)) = temp(jb(k)) + ajj * b(k)
endif
@ -257,10 +269,12 @@ c c = d + ...
temp(i) = 0.
endif
c$$$ if (mod(i,100) == 1)
c$$$ + write(0,*) ' NUMBMM: Fixing row ',i,ic(i),ic(i+1)-1
c$$$ + write(psb_err_unit,*)
c$$$ ' NUMBMM: Fixing row ',i,ic(i),ic(i+1)-1
do 40 j = ic(i),ic(i+1)-1
if((jc(j)<1).or. (jc(j) > maxlmn)) then
write(0,*) ' NUMBMM: output problem',i,j,jc(j),maxlmn
write(psb_err_unit,*)
+ ' NUMBMM: output problem',i,j,jc(j),maxlmn
else
c(j) = temp(jc(j))
temp(jc(j)) = 0.
@ -309,12 +323,14 @@ c b = d + ...
if (diagb.eq.1 .and. j.le.minlm)
* temp(j) = temp(j) + ajj * b(j)
if ((j<1).or.(j>m)) then
write(0,*) ' NUMBMM: Problem with A ',i,jj,j,m
write(psb_err_unit,*)
+ ' NUMBMM: Problem with A ',i,jj,j,m
endif
do 20 k = ib(j),ib(j+1)-1
if((jb(k)<1).or. (jb(k) > maxlmn)) then
write(0,*) ' NUMBMM: jb problem',j,k,jb(k),maxlmn
write(psb_err_unit,*)
+ ' NUMBMM: jb problem',j,k,jb(k),maxlmn
else
temp(jb(k)) = temp(jb(k)) + ajj * b(k)
endif
@ -326,10 +342,12 @@ c c = d + ...
temp(i) = 0.
endif
c$$$ if (mod(i,100) == 1)
c$$$ + write(0,*) ' NUMBMM: Fixing row ',i,ic(i),ic(i+1)-1
c$$$ + write(psb_err_unit,*)
c$$$ ' NUMBMM: Fixing row ',i,ic(i),ic(i+1)-1
do 40 j = ic(i),ic(i+1)-1
if((jc(j)<1).or. (jc(j) > maxlmn)) then
write(0,*) ' NUMBMM: output problem',i,j,jc(j),maxlmn
write(psb_err_unit,*)
+ ' NUMBMM: output problem',i,j,jc(j),maxlmn
else
c(j) = temp(jc(j))
temp(jc(j)) = 0.
@ -378,12 +396,14 @@ c b = d + ...
if (diagb.eq.1 .and. j.le.minlm)
* temp(j) = temp(j) + ajj * b(j)
if ((j<1).or.(j>m)) then
write(0,*) ' NUMBMM: Problem with A ',i,jj,j,m
write(psb_err_unit,*)
+ ' NUMBMM: Problem with A ',i,jj,j,m
endif
do 20 k = ib(j),ib(j+1)-1
if((jb(k)<1).or. (jb(k) > maxlmn)) then
write(0,*) ' NUMBMM: jb problem',j,k,jb(k),maxlmn
write(psb_err_unit,*)
+ ' NUMBMM: jb problem',j,k,jb(k),maxlmn
else
temp(jb(k)) = temp(jb(k)) + ajj * b(k)
endif
@ -395,10 +415,12 @@ c c = d + ...
temp(i) = 0.
endif
c$$$ if (mod(i,100) == 1)
c$$$ + write(0,*) ' NUMBMM: Fixing row ',i,ic(i),ic(i+1)-1
c$$$ + write(psb_err_unit,*)
c$$$ ' NUMBMM: Fixing row ',i,ic(i),ic(i+1)-1
do 40 j = ic(i),ic(i+1)-1
if((jc(j)<1).or. (jc(j) > maxlmn)) then
write(0,*) ' NUMBMM: output problem',i,j,jc(j),maxlmn
write(psb_err_unit,*)
+ ' NUMBMM: output problem',i,j,jc(j),maxlmn
else
c(j) = temp(jc(j))
temp(jc(j)) = 0.

8
base/serial/psb_cnumbmm.f90
Unescape Escape View File

@ -109,7 +109,7 @@ subroutine psb_cbase_numbmm(a,b,c)
if ( mb /= na ) then
write(0,*) 'Mismatch in SYMBMM: ',ma,na,mb,nb
write(psb_err_unit,*) 'Mismatch in SYMBMM: ',ma,na,mb,nb
endif
allocate(temp(max(ma,na,mb,nb)),stat=info)
if (info /= psb_success_) then
@ -210,7 +210,7 @@ contains
j=iacl(jj)
ajj = aval(jj)
if ((j<1).or.(j>m)) then
write(0,*) ' NUMBMM: Problem with A ',i,jj,j,m
write(psb_err_unit,*) ' NUMBMM: Problem with A ',i,jj,j,m
info = 1
return
@ -218,7 +218,7 @@ contains
call b%csget(j,j,nbzr,ibrw,ibcl,bval,info)
do k=1,nbzr
if ((ibcl(k)<1).or.(ibcl(k)>maxlmn)) then
write(0,*) 'Problem in NUMBM 1:',j,k,ibcl(k),maxlmn
write(psb_err_unit,*) 'Problem in NUMBM 1:',j,k,ibcl(k),maxlmn
info = psb_err_pivot_too_small_
return
else
@ -228,7 +228,7 @@ contains
end do
do j = c%irp(i),c%irp(i+1)-1
if((c%ja(j)<1).or. (c%ja(j) > maxlmn)) then
write(0,*) ' NUMBMM: output problem',i,j,c%ja(j),maxlmn
write(psb_err_unit,*) ' NUMBMM: output problem',i,j,c%ja(j),maxlmn
info = psb_err_invalid_ovr_num_
return
else

4
base/serial/psb_crwextd.f90
Unescape Escape View File

@ -158,7 +158,7 @@ subroutine psb_cbase_rwextd(nr,a,info,b,rowscale)
end do
class default
write(0,*) 'Implement SPGETBLK in RWEXTD!!!!!!!'
write(psb_err_unit,*) 'Implement SPGETBLK in RWEXTD!!!!!!!'
end select
call a%set_ncols(max(na,nb))
@ -222,7 +222,7 @@ subroutine psb_cbase_rwextd(nr,a,info,b,rowscale)
call a%set_nzeros(nza)
class default
write(0,*) 'Implement SPGETBLK in RWEXTD!!!!!!!'
write(psb_err_unit,*) 'Implement SPGETBLK in RWEXTD!!!!!!!'
end select

6
base/serial/psb_csymbmm.f90
Unescape Escape View File

@ -107,7 +107,7 @@ subroutine psb_cbase_symbmm(a,b,c,info)
if ( mb /= na ) then
write(0,*) 'Mismatch in SYMBMM: ',ma,na,mb,nb
write(psb_err_unit,*) 'Mismatch in SYMBMM: ',ma,na,mb,nb
endif
allocate(itemp(max(ma,na,mb,nb)),stat=info)
if (info /= psb_success_) then
@ -225,14 +225,14 @@ contains
j=iacl(jj)
if ((j<1).or.(j>m)) then
write(0,*) ' SymbMM: Problem with A ',i,jj,j,m
write(psb_err_unit,*) ' SymbMM: Problem with A ',i,jj,j,m
info = 1
return
endif
call b%csget(j,j,nbzr,ibrw,ibcl,info)
do k=1,nbzr
if ((ibcl(k)<1).or.(ibcl(k)>maxlmn)) then
write(0,*) 'Problem in SYMBMM 1:',j,k,ibcl(k),maxlmn
write(psb_err_unit,*) 'Problem in SYMBMM 1:',j,k,ibcl(k),maxlmn
info=psb_err_pivot_too_small_
return
else

8
base/serial/psb_dnumbmm.f90
Unescape Escape View File

@ -109,7 +109,7 @@ subroutine psb_dbase_numbmm(a,b,c)
if ( mb /= na ) then
write(0,*) 'Mismatch in SYMBMM: ',ma,na,mb,nb
write(psb_err_unit,*) 'Mismatch in SYMBMM: ',ma,na,mb,nb
endif
allocate(temp(max(ma,na,mb,nb)),stat=info)
if (info /= psb_success_) then
@ -210,7 +210,7 @@ contains
j=iacl(jj)
ajj = aval(jj)
if ((j<1).or.(j>m)) then
write(0,*) ' NUMBMM: Problem with A ',i,jj,j,m
write(psb_err_unit,*) ' NUMBMM: Problem with A ',i,jj,j,m
info = 1
return
@ -218,7 +218,7 @@ contains
call b%csget(j,j,nbzr,ibrw,ibcl,bval,info)
do k=1,nbzr
if ((ibcl(k)<1).or.(ibcl(k)>maxlmn)) then
write(0,*) 'Problem in NUMBM 1:',j,k,ibcl(k),maxlmn
write(psb_err_unit,*) 'Problem in NUMBM 1:',j,k,ibcl(k),maxlmn
info = psb_err_pivot_too_small_
return
else
@ -228,7 +228,7 @@ contains
end do
do j = c%irp(i),c%irp(i+1)-1
if((c%ja(j)<1).or. (c%ja(j) > maxlmn)) then
write(0,*) ' NUMBMM: output problem',i,j,c%ja(j),maxlmn
write(psb_err_unit,*) ' NUMBMM: output problem',i,j,c%ja(j),maxlmn
info = psb_err_invalid_ovr_num_
return
else

4
base/serial/psb_drwextd.f90
Unescape Escape View File

@ -158,7 +158,7 @@ subroutine psb_dbase_rwextd(nr,a,info,b,rowscale)
end do
class default
write(0,*) 'Implement SPGETBLK in RWEXTD!!!!!!!'
write(psb_err_unit,*) 'Implement SPGETBLK in RWEXTD!!!!!!!'
end select
call a%set_ncols(max(na,nb))
@ -222,7 +222,7 @@ subroutine psb_dbase_rwextd(nr,a,info,b,rowscale)
call a%set_nzeros(nza)
class default
write(0,*) 'Implement SPGETBLK in RWEXTD!!!!!!!'
write(psb_err_unit,*) 'Implement SPGETBLK in RWEXTD!!!!!!!'
end select

6
base/serial/psb_dsymbmm.f90
Unescape Escape View File

@ -107,7 +107,7 @@ subroutine psb_dbase_symbmm(a,b,c,info)
if ( mb /= na ) then
write(0,*) 'Mismatch in SYMBMM: ',ma,na,mb,nb
write(psb_err_unit,*) 'Mismatch in SYMBMM: ',ma,na,mb,nb
endif
allocate(itemp(max(ma,na,mb,nb)),stat=info)
if (info /= psb_success_) then
@ -225,14 +225,14 @@ contains
j=iacl(jj)
if ((j<1).or.(j>m)) then
write(0,*) ' SymbMM: Problem with A ',i,jj,j,m
write(psb_err_unit,*) ' SymbMM: Problem with A ',i,jj,j,m
info = 1
return
endif
call b%csget(j,j,nbzr,ibrw,ibcl,info)
do k=1,nbzr
if ((ibcl(k)<1).or.(ibcl(k)>maxlmn)) then
write(0,*) 'Problem in SYMBMM 1:',j,k,ibcl(k),maxlmn
write(psb_err_unit,*) 'Problem in SYMBMM 1:',j,k,ibcl(k),maxlmn
info=psb_err_pivot_too_small_
return
else

8
base/serial/psb_snumbmm.f90
Unescape Escape View File

@ -109,7 +109,7 @@ subroutine psb_sbase_numbmm(a,b,c)
if ( mb /= na ) then
write(0,*) 'Mismatch in SYMBMM: ',ma,na,mb,nb
write(psb_err_unit,*) 'Mismatch in SYMBMM: ',ma,na,mb,nb
endif
allocate(temp(max(ma,na,mb,nb)),stat=info)
if (info /= psb_success_) then
@ -210,7 +210,7 @@ contains
j=iacl(jj)
ajj = aval(jj)
if ((j<1).or.(j>m)) then
write(0,*) ' NUMBMM: Problem with A ',i,jj,j,m
write(psb_err_unit,*) ' NUMBMM: Problem with A ',i,jj,j,m
info = 1
return
@ -218,7 +218,7 @@ contains
call b%csget(j,j,nbzr,ibrw,ibcl,bval,info)
do k=1,nbzr
if ((ibcl(k)<1).or.(ibcl(k)>maxlmn)) then
write(0,*) 'Problem in NUMBM 1:',j,k,ibcl(k),maxlmn
write(psb_err_unit,*) 'Problem in NUMBM 1:',j,k,ibcl(k),maxlmn
info = psb_err_pivot_too_small_
return
else
@ -228,7 +228,7 @@ contains
end do
do j = c%irp(i),c%irp(i+1)-1
if((c%ja(j)<1).or. (c%ja(j) > maxlmn)) then
write(0,*) ' NUMBMM: output problem',i,j,c%ja(j),maxlmn
write(psb_err_unit,*) ' NUMBMM: output problem',i,j,c%ja(j),maxlmn
info = psb_err_invalid_ovr_num_
return
else

170
base/serial/psb_sort_impl.f90
Unescape Escape View File

@ -62,7 +62,7 @@ logical function psb_isaperm(n,eip)
do i=1, n
ip(i) = eip(i)
if ((ip(i) < 1).or.(ip(i) > n)) then
write(0,*) 'Out of bounds in isaperm' ,ip(i), n
write(psb_err_unit,*) 'Out of bounds in isaperm' ,ip(i), n
psb_isaperm = .false.
return
endif
@ -968,13 +968,13 @@ subroutine ihsort(x,ix,dir,flag)
index = ix(i)
call psi_insert_int_idx_heap(key,index,l,x,ix,dir_,info)
if (l /= i) then
write(0,*) 'Mismatch while heapifying ! '
write(psb_err_unit,*) 'Mismatch while heapifying ! '
end if
end do
do i=n, 2, -1
call psi_int_idx_heap_get_first(key,index,l,x,ix,dir_,info)
if (l /= i-1) then
write(0,*) 'Mismatch while pulling out of heap ',l,i
write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i
end if
x(i) = key
ix(i) = index
@ -985,13 +985,13 @@ subroutine ihsort(x,ix,dir,flag)
key = x(i)
call psi_insert_int_heap(key,l,x,dir_,info)
if (l /= i) then
write(0,*) 'Mismatch while heapifying ! ',l,i
write(psb_err_unit,*) 'Mismatch while heapifying ! ',l,i
end if
end do
do i=n, 2, -1
call psi_int_heap_get_first(key,l,x,dir_,info)
if (l /= i-1) then
write(0,*) 'Mismatch while pulling out of heap ',l,i
write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i
end if
x(i) = key
end do
@ -1077,13 +1077,13 @@ subroutine shsort(x,ix,dir,flag)
index = ix(i)
call psi_insert_real_idx_heap(key,index,l,x,ix,dir_,info)
if (l /= i) then
write(0,*) 'Mismatch while heapifying ! '
write(psb_err_unit,*) 'Mismatch while heapifying ! '
end if
end do
do i=n, 2, -1
call psi_real_idx_heap_get_first(key,index,l,x,ix,dir_,info)
if (l /= i-1) then
write(0,*) 'Mismatch while pulling out of heap ',l,i
write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i
end if
x(i) = key
ix(i) = index
@ -1094,13 +1094,13 @@ subroutine shsort(x,ix,dir,flag)
key = x(i)
call psi_insert_real_heap(key,l,x,dir_,info)
if (l /= i) then
write(0,*) 'Mismatch while heapifying ! ',l,i
write(psb_err_unit,*) 'Mismatch while heapifying ! ',l,i
end if
end do
do i=n, 2, -1
call psi_real_heap_get_first(key,l,x,dir_,info)
if (l /= i-1) then
write(0,*) 'Mismatch while pulling out of heap ',l,i
write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i
end if
x(i) = key
end do
@ -1186,13 +1186,13 @@ subroutine dhsort(x,ix,dir,flag)
index = ix(i)
call psi_insert_double_idx_heap(key,index,l,x,ix,dir_,info)
if (l /= i) then
write(0,*) 'Mismatch while heapifying ! '
write(psb_err_unit,*) 'Mismatch while heapifying ! '
end if
end do
do i=n, 2, -1
call psi_double_idx_heap_get_first(key,index,l,x,ix,dir_,info)
if (l /= i-1) then
write(0,*) 'Mismatch while pulling out of heap ',l,i
write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i
end if
x(i) = key
ix(i) = index
@ -1203,13 +1203,13 @@ subroutine dhsort(x,ix,dir,flag)
key = x(i)
call psi_insert_double_heap(key,l,x,dir_,info)
if (l /= i) then
write(0,*) 'Mismatch while heapifying ! ',l,i
write(psb_err_unit,*) 'Mismatch while heapifying ! ',l,i
end if
end do
do i=n, 2, -1
call psi_double_heap_get_first(key,l,x,dir_,info)
if (l /= i-1) then
write(0,*) 'Mismatch while pulling out of heap ',l,i
write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i
end if
x(i) = key
end do
@ -1295,13 +1295,13 @@ subroutine chsort(x,ix,dir,flag)
index = ix(i)
call psi_insert_scomplex_idx_heap(key,index,l,x,ix,dir_,info)
if (l /= i) then
write(0,*) 'Mismatch while heapifying ! '
write(psb_err_unit,*) 'Mismatch while heapifying ! '
end if
end do
do i=n, 2, -1
call psi_scomplex_idx_heap_get_first(key,index,l,x,ix,dir_,info)
if (l /= i-1) then
write(0,*) 'Mismatch while pulling out of heap ',l,i
write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i
end if
x(i) = key
ix(i) = index
@ -1312,13 +1312,13 @@ subroutine chsort(x,ix,dir,flag)
key = x(i)
call psi_insert_scomplex_heap(key,l,x,dir_,info)
if (l /= i) then
write(0,*) 'Mismatch while heapifying ! ',l,i
write(psb_err_unit,*) 'Mismatch while heapifying ! ',l,i
end if
end do
do i=n, 2, -1
call psi_scomplex_heap_get_first(key,l,x,dir_,info)
if (l /= i-1) then
write(0,*) 'Mismatch while pulling out of heap ',l,i
write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i
end if
x(i) = key
end do
@ -1404,13 +1404,13 @@ subroutine zhsort(x,ix,dir,flag)
index = ix(i)
call psi_insert_dcomplex_idx_heap(key,index,l,x,ix,dir_,info)
if (l /= i) then
write(0,*) 'Mismatch while heapifying ! '
write(psb_err_unit,*) 'Mismatch while heapifying ! '
end if
end do
do i=n, 2, -1
call psi_dcomplex_idx_heap_get_first(key,index,l,x,ix,dir_,info)
if (l /= i-1) then
write(0,*) 'Mismatch while pulling out of heap ',l,i
write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i
end if
x(i) = key
ix(i) = index
@ -1421,13 +1421,13 @@ subroutine zhsort(x,ix,dir,flag)
key = x(i)
call psi_insert_dcomplex_heap(key,l,x,dir_,info)
if (l /= i) then
write(0,*) 'Mismatch while heapifying ! ',l,i
write(psb_err_unit,*) 'Mismatch while heapifying ! ',l,i
end if
end do
do i=n, 2, -1
call psi_dcomplex_heap_get_first(key,l,x,dir_,info)
if (l /= i-1) then
write(0,*) 'Mismatch while pulling out of heap ',l,i
write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i
end if
x(i) = key
end do
@ -1469,7 +1469,7 @@ subroutine psb_init_int_heap(heap,info,dir)
case (psb_sort_up_,psb_sort_down_,psb_asort_up_,psb_asort_down_)
! ok, do nothing
case default
write(0,*) 'Invalid direction, defaulting to psb_sort_up_'
write(psb_err_unit,*) 'Invalid direction, defaulting to psb_sort_up_'
heap%dir = psb_sort_up_
end select
@ -1486,7 +1486,7 @@ subroutine psb_dump_int_heap(iout,heap,info)
info = psb_success_
if (iout < 0) then
write(0,*) 'Invalid file '
write(psb_err_unit,*) 'Invalid file '
info =-1
return
end if
@ -1514,7 +1514,7 @@ subroutine psb_insert_int_heap(key,heap,info)
info = psb_success_
if (heap%last < 0) then
write(0,*) 'Invalid last in heap ',heap%last
write(psb_err_unit,*) 'Invalid last in heap ',heap%last
info = heap%last
return
endif
@ -1522,7 +1522,7 @@ subroutine psb_insert_int_heap(key,heap,info)
heap%last = heap%last
call psb_ensure_size(heap%last+1,heap%keys,info,addsz=psb_heap_resize)
if (info /= psb_success_) then
write(0,*) 'Memory allocation failure in heap_insert'
write(psb_err_unit,*) 'Memory allocation failure in heap_insert'
info = -5
return
end if
@ -1574,7 +1574,7 @@ subroutine psb_init_real_idx_heap(heap,info,dir)
case (psb_sort_up_,psb_sort_down_,psb_asort_up_,psb_asort_down_)
! ok, do nothing
case default
write(0,*) 'Invalid direction, defaulting to psb_sort_up_'
write(psb_err_unit,*) 'Invalid direction, defaulting to psb_sort_up_'
heap%dir = psb_sort_up_
end select
@ -1592,7 +1592,7 @@ subroutine psb_dump_real_idx_heap(iout,heap,info)
info = psb_success_
if (iout < 0) then
write(0,*) 'Invalid file '
write(psb_err_unit,*) 'Invalid file '
info =-1
return
end if
@ -1625,7 +1625,7 @@ subroutine psb_insert_real_idx_heap(key,index,heap,info)
info = psb_success_
if (heap%last < 0) then
write(0,*) 'Invalid last in heap ',heap%last
write(psb_err_unit,*) 'Invalid last in heap ',heap%last
info = heap%last
return
endif
@ -1634,7 +1634,7 @@ subroutine psb_insert_real_idx_heap(key,index,heap,info)
if (info == psb_success_) &
& call psb_ensure_size(heap%last+1,heap%idxs,info,addsz=psb_heap_resize)
if (info /= psb_success_) then
write(0,*) 'Memory allocation failure in heap_insert'
write(psb_err_unit,*) 'Memory allocation failure in heap_insert'
info = -5
return
end if
@ -1689,7 +1689,7 @@ subroutine psb_init_double_idx_heap(heap,info,dir)
case (psb_sort_up_,psb_sort_down_,psb_asort_up_,psb_asort_down_)
! ok, do nothing
case default
write(0,*) 'Invalid direction, defaulting to psb_sort_up_'
write(psb_err_unit,*) 'Invalid direction, defaulting to psb_sort_up_'
heap%dir = psb_sort_up_
end select
@ -1707,7 +1707,7 @@ subroutine psb_dump_double_idx_heap(iout,heap,info)
info = psb_success_
if (iout < 0) then
write(0,*) 'Invalid file '
write(psb_err_unit,*) 'Invalid file '
info =-1
return
end if
@ -1740,7 +1740,7 @@ subroutine psb_insert_double_idx_heap(key,index,heap,info)
info = psb_success_
if (heap%last < 0) then
write(0,*) 'Invalid last in heap ',heap%last
write(psb_err_unit,*) 'Invalid last in heap ',heap%last
info = heap%last
return
endif
@ -1749,7 +1749,7 @@ subroutine psb_insert_double_idx_heap(key,index,heap,info)
if (info == psb_success_) &
& call psb_ensure_size(heap%last+1,heap%idxs,info,addsz=psb_heap_resize)
if (info /= psb_success_) then
write(0,*) 'Memory allocation failure in heap_insert'
write(psb_err_unit,*) 'Memory allocation failure in heap_insert'
info = -5
return
end if
@ -1803,7 +1803,7 @@ subroutine psb_init_int_idx_heap(heap,info,dir)
case (psb_sort_up_,psb_sort_down_,psb_asort_up_,psb_asort_down_)
! ok, do nothing
case default
write(0,*) 'Invalid direction, defaulting to psb_sort_up_'
write(psb_err_unit,*) 'Invalid direction, defaulting to psb_sort_up_'
heap%dir = psb_sort_up_
end select
@ -1821,7 +1821,7 @@ subroutine psb_dump_int_idx_heap(iout,heap,info)
info = psb_success_
if (iout < 0) then
write(0,*) 'Invalid file '
write(psb_err_unit,*) 'Invalid file '
info =-1
return
end if
@ -1854,7 +1854,7 @@ subroutine psb_insert_int_idx_heap(key,index,heap,info)
info = psb_success_
if (heap%last < 0) then
write(0,*) 'Invalid last in heap ',heap%last
write(psb_err_unit,*) 'Invalid last in heap ',heap%last
info = heap%last
return
endif
@ -1863,7 +1863,7 @@ subroutine psb_insert_int_idx_heap(key,index,heap,info)
if (info == psb_success_) &
& call psb_ensure_size(heap%last+1,heap%idxs,info,addsz=psb_heap_resize)
if (info /= psb_success_) then
write(0,*) 'Memory allocation failure in heap_insert'
write(psb_err_unit,*) 'Memory allocation failure in heap_insert'
info = -5
return
end if
@ -1920,7 +1920,7 @@ subroutine psb_init_scomplex_idx_heap(heap,info,dir)
case (psb_asort_up_,psb_asort_down_)
! ok, do nothing
case default
write(0,*) 'Invalid direction, defaulting to psb_sort_up_'
write(psb_err_unit,*) 'Invalid direction, defaulting to psb_sort_up_'
heap%dir = psb_asort_up_
end select
@ -1938,7 +1938,7 @@ subroutine psb_dump_scomplex_idx_heap(iout,heap,info)
info = psb_success_
if (iout < 0) then
write(0,*) 'Invalid file '
write(psb_err_unit,*) 'Invalid file '
info =-1
return
end if
@ -1971,7 +1971,7 @@ subroutine psb_insert_scomplex_idx_heap(key,index,heap,info)
info = psb_success_
if (heap%last < 0) then
write(0,*) 'Invalid last in heap ',heap%last
write(psb_err_unit,*) 'Invalid last in heap ',heap%last
info = heap%last
return
endif
@ -1980,7 +1980,7 @@ subroutine psb_insert_scomplex_idx_heap(key,index,heap,info)
if (info == psb_success_) &
& call psb_ensure_size(heap%last+1,heap%idxs,info,addsz=psb_heap_resize)
if (info /= psb_success_) then
write(0,*) 'Memory allocation failure in heap_insert'
write(psb_err_unit,*) 'Memory allocation failure in heap_insert'
info = -5
return
end if
@ -2037,7 +2037,7 @@ subroutine psb_init_dcomplex_idx_heap(heap,info,dir)
case (psb_asort_up_,psb_asort_down_)
! ok, do nothing
case default
write(0,*) 'Invalid direction, defaulting to psb_sort_up_'
write(psb_err_unit,*) 'Invalid direction, defaulting to psb_sort_up_'
heap%dir = psb_asort_up_
end select
@ -2055,7 +2055,7 @@ subroutine psb_dump_dcomplex_idx_heap(iout,heap,info)
info = psb_success_
if (iout < 0) then
write(0,*) 'Invalid file '
write(psb_err_unit,*) 'Invalid file '
info =-1
return
end if
@ -2088,7 +2088,7 @@ subroutine psb_insert_dcomplex_idx_heap(key,index,heap,info)
info = psb_success_
if (heap%last < 0) then
write(0,*) 'Invalid last in heap ',heap%last
write(psb_err_unit,*) 'Invalid last in heap ',heap%last
info = heap%last
return
endif
@ -2097,7 +2097,7 @@ subroutine psb_insert_dcomplex_idx_heap(key,index,heap,info)
if (info == psb_success_) &
& call psb_ensure_size(heap%last+1,heap%idxs,info,addsz=psb_heap_resize)
if (info /= psb_success_) then
write(0,*) 'Memory allocation failure in heap_insert'
write(psb_err_unit,*) 'Memory allocation failure in heap_insert'
info = -5
return
end if
@ -2151,13 +2151,13 @@ subroutine psi_insert_int_heap(key,last,heap,dir,info)
info = psb_success_
if (last < 0) then
write(0,*) 'Invalid last in heap ',last
write(psb_err_unit,*) 'Invalid last in heap ',last
info = last
return
endif
last = last + 1
if (last > size(heap)) then
write(0,*) 'out of bounds '
write(psb_err_unit,*) 'out of bounds '
info = -1
return
end if
@ -2229,7 +2229,7 @@ subroutine psi_insert_int_heap(key,last,heap,dir,info)
case default
write(0,*) 'Invalid direction in heap ',dir
write(psb_err_unit,*) 'Invalid direction in heap ',dir
end select
return
@ -2352,7 +2352,7 @@ subroutine psi_int_heap_get_first(key,last,heap,dir,info)
end do
case default
write(0,*) 'Invalid direction in heap ',dir
write(psb_err_unit,*) 'Invalid direction in heap ',dir
end select
return
@ -2381,13 +2381,13 @@ subroutine psi_insert_real_heap(key,last,heap,dir,info)
info = psb_success_
if (last < 0) then
write(0,*) 'Invalid last in heap ',last
write(psb_err_unit,*) 'Invalid last in heap ',last
info = last
return
endif
last = last + 1
if (last > size(heap)) then
write(0,*) 'out of bounds '
write(psb_err_unit,*) 'out of bounds '
info = -1
return
end if
@ -2459,7 +2459,7 @@ subroutine psi_insert_real_heap(key,last,heap,dir,info)
case default
write(0,*) 'Invalid direction in heap ',dir
write(psb_err_unit,*) 'Invalid direction in heap ',dir
end select
return
@ -2583,7 +2583,7 @@ subroutine psi_real_heap_get_first(key,last,heap,dir,info)
end do
case default
write(0,*) 'Invalid direction in heap ',dir
write(psb_err_unit,*) 'Invalid direction in heap ',dir
end select
return
@ -2611,13 +2611,13 @@ subroutine psi_insert_double_heap(key,last,heap,dir,info)
info = psb_success_
if (last < 0) then
write(0,*) 'Invalid last in heap ',last
write(psb_err_unit,*) 'Invalid last in heap ',last
info = last
return
endif
last = last + 1
if (last > size(heap)) then
write(0,*) 'out of bounds '
write(psb_err_unit,*) 'out of bounds '
info = -1
return
end if
@ -2689,7 +2689,7 @@ subroutine psi_insert_double_heap(key,last,heap,dir,info)
case default
write(0,*) 'Invalid direction in heap ',dir
write(psb_err_unit,*) 'Invalid direction in heap ',dir
end select
return
@ -2813,7 +2813,7 @@ subroutine psi_double_heap_get_first(key,last,heap,dir,info)
end do
case default
write(0,*) 'Invalid direction in heap ',dir
write(psb_err_unit,*) 'Invalid direction in heap ',dir
end select
return
@ -2843,13 +2843,13 @@ subroutine psi_insert_scomplex_heap(key,last,heap,dir,info)
info = psb_success_
if (last < 0) then
write(0,*) 'Invalid last in heap ',last
write(psb_err_unit,*) 'Invalid last in heap ',last
info = last
return
endif
last = last + 1
if (last > size(heap)) then
write(0,*) 'out of bounds '
write(psb_err_unit,*) 'out of bounds '
info = -1
return
end if
@ -2921,7 +2921,7 @@ subroutine psi_insert_scomplex_heap(key,last,heap,dir,info)
case default
write(0,*) 'Invalid direction in heap ',dir
write(psb_err_unit,*) 'Invalid direction in heap ',dir
end select
return
@ -3045,7 +3045,7 @@ subroutine psi_scomplex_heap_get_first(key,last,heap,dir,info)
end do
case default
write(0,*) 'Invalid direction in heap ',dir
write(psb_err_unit,*) 'Invalid direction in heap ',dir
end select
return
@ -3073,13 +3073,13 @@ subroutine psi_insert_dcomplex_heap(key,last,heap,dir,info)
info = psb_success_
if (last < 0) then
write(0,*) 'Invalid last in heap ',last
write(psb_err_unit,*) 'Invalid last in heap ',last
info = last
return
endif
last = last + 1
if (last > size(heap)) then
write(0,*) 'out of bounds '
write(psb_err_unit,*) 'out of bounds '
info = -1
return
end if
@ -3151,7 +3151,7 @@ subroutine psi_insert_dcomplex_heap(key,last,heap,dir,info)
case default
write(0,*) 'Invalid direction in heap ',dir
write(psb_err_unit,*) 'Invalid direction in heap ',dir
end select
return
@ -3275,7 +3275,7 @@ subroutine psi_dcomplex_heap_get_first(key,last,heap,dir,info)
end do
case default
write(0,*) 'Invalid direction in heap ',dir
write(psb_err_unit,*) 'Invalid direction in heap ',dir
end select
return
@ -3307,14 +3307,14 @@ subroutine psi_insert_int_idx_heap(key,index,last,heap,idxs,dir,info)
info = psb_success_
if (last < 0) then
write(0,*) 'Invalid last in heap ',last
write(psb_err_unit,*) 'Invalid last in heap ',last
info = last
return
endif
last = last + 1
if (last > size(heap)) then
write(0,*) 'out of bounds '
write(psb_err_unit,*) 'out of bounds '
info = -1
return
end if
@ -3400,7 +3400,7 @@ subroutine psi_insert_int_idx_heap(key,index,last,heap,idxs,dir,info)
case default
write(0,*) 'Invalid direction in heap ',dir
write(psb_err_unit,*) 'Invalid direction in heap ',dir
end select
return
@ -3537,7 +3537,7 @@ subroutine psi_int_idx_heap_get_first(key,index,last,heap,idxs,dir,info)
end do
case default
write(0,*) 'Invalid direction in heap ',dir
write(psb_err_unit,*) 'Invalid direction in heap ',dir
end select
return
@ -3566,14 +3566,14 @@ subroutine psi_insert_real_idx_heap(key,index,last,heap,idxs,dir,info)
info = psb_success_
if (last < 0) then
write(0,*) 'Invalid last in heap ',last
write(psb_err_unit,*) 'Invalid last in heap ',last
info = last
return
endif
last = last + 1
if (last > size(heap)) then
write(0,*) 'out of bounds '
write(psb_err_unit,*) 'out of bounds '
info = -1
return
end if
@ -3659,7 +3659,7 @@ subroutine psi_insert_real_idx_heap(key,index,last,heap,idxs,dir,info)
case default
write(0,*) 'Invalid direction in heap ',dir
write(psb_err_unit,*) 'Invalid direction in heap ',dir
end select
return
@ -3796,7 +3796,7 @@ subroutine psi_real_idx_heap_get_first(key,index,last,heap,idxs,dir,info)
end do
case default
write(0,*) 'Invalid direction in heap ',dir
write(psb_err_unit,*) 'Invalid direction in heap ',dir
end select
return
@ -3826,14 +3826,14 @@ subroutine psi_insert_double_idx_heap(key,index,last,heap,idxs,dir,info)
info = psb_success_
if (last < 0) then
write(0,*) 'Invalid last in heap ',last
write(psb_err_unit,*) 'Invalid last in heap ',last
info = last
return
endif
last = last + 1
if (last > size(heap)) then
write(0,*) 'out of bounds '
write(psb_err_unit,*) 'out of bounds '
info = -1
return
end if
@ -3919,7 +3919,7 @@ subroutine psi_insert_double_idx_heap(key,index,last,heap,idxs,dir,info)
case default
write(0,*) 'Invalid direction in heap ',dir
write(psb_err_unit,*) 'Invalid direction in heap ',dir
end select
return
@ -4056,7 +4056,7 @@ subroutine psi_double_idx_heap_get_first(key,index,last,heap,idxs,dir,info)
end do
case default
write(0,*) 'Invalid direction in heap ',dir
write(psb_err_unit,*) 'Invalid direction in heap ',dir
end select
return
@ -4086,14 +4086,14 @@ subroutine psi_insert_scomplex_idx_heap(key,index,last,heap,idxs,dir,info)
info = psb_success_
if (last < 0) then
write(0,*) 'Invalid last in heap ',last
write(psb_err_unit,*) 'Invalid last in heap ',last
info = last
return
endif
last = last + 1
if (last > size(heap)) then
write(0,*) 'out of bounds '
write(psb_err_unit,*) 'out of bounds '
info = -1
return
end if
@ -4179,7 +4179,7 @@ subroutine psi_insert_scomplex_idx_heap(key,index,last,heap,idxs,dir,info)
case default
write(0,*) 'Invalid direction in heap ',dir
write(psb_err_unit,*) 'Invalid direction in heap ',dir
end select
return
@ -4316,7 +4316,7 @@ subroutine psi_scomplex_idx_heap_get_first(key,index,last,heap,idxs,dir,info)
end do
case default
write(0,*) 'Invalid direction in heap ',dir
write(psb_err_unit,*) 'Invalid direction in heap ',dir
end select
return
@ -4346,14 +4346,14 @@ subroutine psi_insert_dcomplex_idx_heap(key,index,last,heap,idxs,dir,info)
info = psb_success_
if (last < 0) then
write(0,*) 'Invalid last in heap ',last
write(psb_err_unit,*) 'Invalid last in heap ',last
info = last
return
endif
last = last + 1
if (last > size(heap)) then
write(0,*) 'out of bounds '
write(psb_err_unit,*) 'out of bounds '
info = -1
return
end if
@ -4439,7 +4439,7 @@ subroutine psi_insert_dcomplex_idx_heap(key,index,last,heap,idxs,dir,info)
case default
write(0,*) 'Invalid direction in heap ',dir
write(psb_err_unit,*) 'Invalid direction in heap ',dir
end select
return
@ -4576,7 +4576,7 @@ subroutine psi_dcomplex_idx_heap_get_first(key,index,last,heap,idxs,dir,info)
end do
case default
write(0,*) 'Invalid direction in heap ',dir
write(psb_err_unit,*) 'Invalid direction in heap ',dir
end select
return

4
base/serial/psb_srwextd.f90
Unescape Escape View File

@ -158,7 +158,7 @@ subroutine psb_sbase_rwextd(nr,a,info,b,rowscale)
end do
class default
write(0,*) 'Implement SPGETBLK in RWEXTD!!!!!!!'
write(psb_err_unit,*) 'Implement SPGETBLK in RWEXTD!!!!!!!'
end select
call a%set_ncols(max(na,nb))
@ -222,7 +222,7 @@ subroutine psb_sbase_rwextd(nr,a,info,b,rowscale)
call a%set_nzeros(nza)
class default
write(0,*) 'Implement SPGETBLK in RWEXTD!!!!!!!'
write(psb_err_unit,*) 'Implement SPGETBLK in RWEXTD!!!!!!!'
end select

6
base/serial/psb_ssymbmm.f90
Unescape Escape View File

@ -107,7 +107,7 @@ subroutine psb_sbase_symbmm(a,b,c,info)
if ( mb /= na ) then
write(0,*) 'Mismatch in SYMBMM: ',ma,na,mb,nb
write(psb_err_unit,*) 'Mismatch in SYMBMM: ',ma,na,mb,nb
endif
allocate(itemp(max(ma,na,mb,nb)),stat=info)
if (info /= psb_success_) then
@ -225,14 +225,14 @@ contains
j=iacl(jj)
if ((j<1).or.(j>m)) then
write(0,*) ' SymbMM: Problem with A ',i,jj,j,m
write(psb_err_unit,*) ' SymbMM: Problem with A ',i,jj,j,m
info = 1
return
endif
call b%csget(j,j,nbzr,ibrw,ibcl,info)
do k=1,nbzr
if ((ibcl(k)<1).or.(ibcl(k)>maxlmn)) then
write(0,*) 'Problem in SYMBMM 1:',j,k,ibcl(k),maxlmn
write(psb_err_unit,*) 'Problem in SYMBMM 1:',j,k,ibcl(k),maxlmn
info=psb_err_pivot_too_small_
return
else

8
base/serial/psb_znumbmm.f90
Unescape Escape View File

@ -109,7 +109,7 @@ subroutine psb_zbase_numbmm(a,b,c)
if ( mb /= na ) then
write(0,*) 'Mismatch in SYMBMM: ',ma,na,mb,nb
write(psb_err_unit,*) 'Mismatch in SYMBMM: ',ma,na,mb,nb
endif
allocate(temp(max(ma,na,mb,nb)),stat=info)
if (info /= psb_success_) then
@ -210,7 +210,7 @@ contains
j=iacl(jj)
ajj = aval(jj)
if ((j<1).or.(j>m)) then
write(0,*) ' NUMBMM: Problem with A ',i,jj,j,m
write(psb_err_unit,*) ' NUMBMM: Problem with A ',i,jj,j,m
info = 1
return
@ -218,7 +218,7 @@ contains
call b%csget(j,j,nbzr,ibrw,ibcl,bval,info)
do k=1,nbzr
if ((ibcl(k)<1).or.(ibcl(k)>maxlmn)) then
write(0,*) 'Problem in NUMBM 1:',j,k,ibcl(k),maxlmn
write(psb_err_unit,*) 'Problem in NUMBM 1:',j,k,ibcl(k),maxlmn
info = psb_err_pivot_too_small_
return
else
@ -228,7 +228,7 @@ contains
end do
do j = c%irp(i),c%irp(i+1)-1
if((c%ja(j)<1).or. (c%ja(j) > maxlmn)) then
write(0,*) ' NUMBMM: output problem',i,j,c%ja(j),maxlmn
write(psb_err_unit,*) ' NUMBMM: output problem',i,j,c%ja(j),maxlmn
info = psb_err_invalid_ovr_num_
return
else

4
base/serial/psb_zrwextd.f90
Unescape Escape View File

@ -158,7 +158,7 @@ subroutine psb_zbase_rwextd(nr,a,info,b,rowscale)
end do
class default
write(0,*) 'Implement SPGETBLK in RWEXTD!!!!!!!'
write(psb_err_unit,*) 'Implement SPGETBLK in RWEXTD!!!!!!!'
end select
call a%set_ncols(max(na,nb))
@ -222,7 +222,7 @@ subroutine psb_zbase_rwextd(nr,a,info,b,rowscale)
call a%set_nzeros(nza)
class default
write(0,*) 'Implement SPGETBLK in RWEXTD!!!!!!!'
write(psb_err_unit,*) 'Implement SPGETBLK in RWEXTD!!!!!!!'
end select

6
base/serial/psb_zsymbmm.f90
Unescape Escape View File

@ -107,7 +107,7 @@ subroutine psb_zbase_symbmm(a,b,c,info)
if ( mb /= na ) then
write(0,*) 'Mismatch in SYMBMM: ',ma,na,mb,nb
write(psb_err_unit,*) 'Mismatch in SYMBMM: ',ma,na,mb,nb
endif
allocate(itemp(max(ma,na,mb,nb)),stat=info)
if (info /= psb_success_) then
@ -225,14 +225,14 @@ contains
j=iacl(jj)
if ((j<1).or.(j>m)) then
write(0,*) ' SymbMM: Problem with A ',i,jj,j,m
write(psb_err_unit,*) ' SymbMM: Problem with A ',i,jj,j,m
info = 1
return
endif
call b%csget(j,j,nbzr,ibrw,ibcl,info)
do k=1,nbzr
if ((ibcl(k)<1).or.(ibcl(k)>maxlmn)) then
write(0,*) 'Problem in SYMBMM 1:',j,k,ibcl(k),maxlmn
write(psb_err_unit,*) 'Problem in SYMBMM 1:',j,k,ibcl(k),maxlmn
info=psb_err_pivot_too_small_
return
else

4
base/serial/psi_impl.f90
Unescape Escape View File

@ -440,7 +440,7 @@
key = x(i)
ih = iand(key,hashmask)
if (ih > ubound(hashv,1) ) then
write(0,*) ' In inner cnv: ',ih,ubound(hashv)
write(psb_err_unit,*) ' In inner cnv: ',ih,ubound(hashv)
end if
idx = hashv(ih)
nh = hashv(ih+1) - hashv(ih)
@ -475,7 +475,7 @@
key = x(i)
ih = iand(key,hashmask)
if (ih > ubound(hashv,1) ) then
write(0,*) ' In inner cnv: ',ih,ubound(hashv)
write(psb_err_unit,*) ' In inner cnv: ',ih,ubound(hashv)
end if
idx = hashv(ih)
nh = hashv(ih+1) - hashv(ih)

2
base/tools/psb_ccdbldext.F90
Unescape Escape View File

@ -552,7 +552,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
Do i=1,iszr
idx=workr(i)
if (idx <1) then
write(0,*) me,'Error in CDBLDEXTBLD level',i_ovr,' : ',idx,i,iszr
write(psb_err_unit,*) me,'Error in CDBLDEXTBLD level',i_ovr,' : ',idx,i,iszr
else If (desc_ov%idxmap%glob_to_loc(idx) < -np) Then
!
! This is a new index. Assigning a local index as

4
base/tools/psb_cd_inloc.f90
Unescape Escape View File

@ -210,8 +210,8 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck)
end do
if ((m /= nrt).and.(me == psb_root_)) then
write(0,*) trim(name),' Warning: globalcheck=.false., but there is a mismatch'
write(0,*) trim(name),' : in the global sizes!',m,nrt
write(psb_err_unit,*) trim(name),' Warning: globalcheck=.false., but there is a mismatch'
write(psb_err_unit,*) trim(name),' : in the global sizes!',m,nrt
end if
end if

8
base/tools/psb_cd_set_bld.f90
Unescape Escape View File

@ -50,7 +50,7 @@ subroutine psb_cd_set_bld(desc,info)
integer :: np,me,ictxt, err_act,idx,gidx,lidx,nc
logical, parameter :: debug=.false.,debugprt=.false.
character(len=20) :: name
if (debug) write(0,*) me,'Entered CDCPY'
if (debug) write(psb_err_unit,*) me,'Entered CDCPY'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
@ -58,10 +58,10 @@ subroutine psb_cd_set_bld(desc,info)
ictxt = psb_cd_get_context(desc)
if (debug) write(0,*)'Entered CDSETBLD',ictxt
if (debug) write(psb_err_unit,*)'Entered CDSETBLD',ictxt
! check on blacs grid
call psb_info(ictxt, me, np)
if (debug) write(0,*) me,'Entered CDSETBLD'
if (debug) write(psb_err_unit,*) me,'Entered CDSETBLD'
if (psb_is_asb_desc(desc)) then
end if
@ -95,7 +95,7 @@ subroutine psb_cd_set_bld(desc,info)
end if
if (debug) write(0,*) me,'SET_BLD: done'
if (debug) write(psb_err_unit,*) me,'SET_BLD: done'
call psb_erractionrestore(err_act)
return

2
base/tools/psb_cdins.f90
Unescape Escape View File

@ -124,7 +124,7 @@ subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla)
& call psb_cdins(nz,ja,desc_a,info,jla=jla,mask=(ila(1:nz)>0))
else
if (present(ila).or.present(jla)) then
write(0,*) 'Inconsistent call : ',present(ila),present(jla)
write(psb_err_unit,*) 'Inconsistent call : ',present(ila),present(jla)
endif
allocate(ila_(nz),stat=info)
if (info /= psb_success_) then

2
base/tools/psb_cspins.f90
Unescape Escape View File

@ -328,7 +328,7 @@ subroutine psb_cspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
else if (psb_is_asb_desc(desc_ac)) then
write(0,*) 'Why are you calling me on an assembled desc_ac?'
write(psb_err_unit,*) 'Why are you calling me on an assembled desc_ac?'
!!$ if (psb_is_large_desc(desc_a)) then
!!$
!!$ allocate(ila(nz),jla(nz),stat=info)

2
base/tools/psb_dcdbldext.F90
Unescape Escape View File

@ -551,7 +551,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
Do i=1,iszr
idx=workr(i)
if (idx <1) then
write(0,*) me,'Error in CDBLDEXTBLD level',i_ovr,' : ',idx,i,iszr
write(psb_err_unit,*) me,'Error in CDBLDEXTBLD level',i_ovr,' : ',idx,i,iszr
else If (desc_ov%idxmap%glob_to_loc(idx) < -np) Then
!
! This is a new index. Assigning a local index as

2
base/tools/psb_dspins.f90
Unescape Escape View File

@ -326,7 +326,7 @@ subroutine psb_dspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
else if (psb_is_asb_desc(desc_ac)) then
write(0,*) 'Why are you calling me on an assembled desc_ac?'
write(psb_err_unit,*) 'Why are you calling me on an assembled desc_ac?'
!!$ if (psb_is_large_desc(desc_a)) then
!!$
!!$ allocate(ila(nz),jla(nz),stat=info)

6
base/tools/psb_glob_to_loc.f90
Unescape Escape View File

@ -93,7 +93,7 @@ subroutine psb_glob_to_loc2(x,y,desc_a,info,iact,owned)
return
case('W')
if ((info /= psb_success_).or.(count(y(1:n)<0) >0)) then
write(0,'("Error ",i5," in subroutine glob_to_loc")') info
write(psb_err_unit,'("Error ",i5," in subroutine glob_to_loc")') info
end if
case('A')
if ((info /= psb_success_).or.(count(y(1:n)<0) >0)) then
@ -216,11 +216,11 @@ subroutine psb_glob_to_loc(x,desc_a,info,iact,owned)
return
case('W')
if ((info /= psb_success_).or.(count(x(1:n)<0) >0)) then
write(0,'("Error ",i5," in subroutine glob_to_loc")') info
write(psb_err_unit,'("Error ",i5," in subroutine glob_to_loc")') info
end if
case('A')
if ((info /= psb_success_).or.(count(x(1:n)<0) >0)) then
write(0,*) count(x(1:n)<0)
write(psb_err_unit,*) count(x(1:n)<0)
call psb_errpush(info,name)
goto 9999
end if

20
base/tools/psb_linmap.f90
Unescape Escape View File

@ -89,7 +89,7 @@ function psb_c_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) res
allocate(this%iaggr(0), this%naggr(0), stat=info)
case default
write(0,*) 'Bad map kind into psb_linmap ',map_kind
write(psb_err_unit,*) 'Bad map kind into psb_linmap ',map_kind
info = 1
end select
@ -100,7 +100,7 @@ function psb_c_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) res
call psb_set_map_kind(map_kind, this)
end if
if (info /= psb_success_) then
write(0,*) trim(name),' Invalid descriptor input'
write(psb_err_unit,*) trim(name),' Invalid descriptor input'
return
end if
@ -167,7 +167,7 @@ function psb_d_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) res
allocate(this%iaggr(0), this%naggr(0), stat=info)
case default
write(0,*) 'Bad map kind into psb_linmap ',map_kind
write(psb_err_unit,*) 'Bad map kind into psb_linmap ',map_kind
info = 1
end select
@ -178,12 +178,12 @@ function psb_d_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) res
call psb_set_map_kind(map_kind, this)
end if
if (info /= psb_success_) then
write(0,*) trim(name),' Invalid descriptor input'
write(psb_err_unit,*) trim(name),' Invalid descriptor input'
return
end if
if (debug) then
!!$ write(0,*) trim(name),' forward map:',allocated(this%map_X2Y%aspk)
!!$ write(0,*) trim(name),' backward map:',allocated(this%map_Y2X%aspk)
!!$ write(psb_err_unit,*) trim(name),' forward map:',allocated(this%map_X2Y%aspk)
!!$ write(psb_err_unit,*) trim(name),' backward map:',allocated(this%map_Y2X%aspk)
end if
end function psb_d_linmap
@ -249,7 +249,7 @@ function psb_s_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) res
allocate(this%iaggr(0), this%naggr(0), stat=info)
case default
write(0,*) 'Bad map kind into psb_linmap ',map_kind
write(psb_err_unit,*) 'Bad map kind into psb_linmap ',map_kind
info = 1
end select
@ -261,7 +261,7 @@ function psb_s_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) res
call psb_set_map_kind(map_kind, this)
end if
if (info /= psb_success_) then
write(0,*) trim(name),' Invalid descriptor input'
write(psb_err_unit,*) trim(name),' Invalid descriptor input'
return
end if
@ -327,7 +327,7 @@ function psb_z_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) res
allocate(this%iaggr(0), this%naggr(0), stat=info)
case default
write(0,*) 'Bad map kind into psb_linmap ',map_kind
write(psb_err_unit,*) 'Bad map kind into psb_linmap ',map_kind
info = 1
end select
@ -338,7 +338,7 @@ function psb_z_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) res
call psb_set_map_kind(map_kind, this)
end if
if (info /= psb_success_) then
write(0,*) trim(name),' Invalid descriptor input'
write(psb_err_unit,*) trim(name),' Invalid descriptor input'
return
end if

4
base/tools/psb_loc_to_glob.f90
Unescape Escape View File

@ -82,7 +82,7 @@ subroutine psb_loc_to_glob2(x,y,desc_a,info,iact)
! do nothing, silently.
info = psb_success_
case('W')
write(0,'("Error ",i5," in subroutine loc_to_glob")') info
write(psb_err_unit,'("Error ",i5," in subroutine loc_to_glob")') info
info = psb_success_
case('A')
call psb_errpush(info,name)
@ -187,7 +187,7 @@ subroutine psb_loc_to_glob(x,desc_a,info,iact)
! do nothing, silently.
info = psb_success_
case('W')
write(0,'("Error ",i5," in subroutine loc_to_glob")') info
write(psb_err_unit,'("Error ",i5," in subroutine loc_to_glob")') info
info = psb_success_
case('A')
call psb_errpush(info,name)

64
base/tools/psb_map.f90
Unescape Escape View File

@ -50,7 +50,7 @@ subroutine psb_s_map_X2Y(alpha,x,beta,y,map,info,work)
info = psb_success_
if (.not.psb_is_asb_map(map)) then
write(0,*) trim(name),' Invalid descriptor input'
write(psb_err_unit,*) trim(name),' Invalid descriptor input'
info = 1
return
end if
@ -71,7 +71,7 @@ subroutine psb_s_map_X2Y(alpha,x,beta,y,map,info,work)
end if
if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_Y,info)
if (info /= psb_success_) then
write(0,*) trim(name),' Error from inner routines',info
write(psb_err_unit,*) trim(name),' Error from inner routines',info
info = -1
end if
@ -91,13 +91,13 @@ subroutine psb_s_map_X2Y(alpha,x,beta,y,map,info,work)
end if
if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_Y,info)
if (info /= psb_success_) then
write(0,*) trim(name),' Error from inner routines',info
write(psb_err_unit,*) trim(name),' Error from inner routines',info
info = -1
end if
case default
write(0,*) trim(name),' Invalid descriptor input'
write(psb_err_unit,*) trim(name),' Invalid descriptor input'
info = 1
return
end select
@ -129,7 +129,7 @@ subroutine psb_s_map_Y2X(alpha,x,beta,y,map,info,work)
info = psb_success_
if (.not.psb_is_asb_map(map)) then
write(0,*) trim(name),' Invalid descriptor input'
write(psb_err_unit,*) trim(name),' Invalid descriptor input'
info = 1
return
end if
@ -150,7 +150,7 @@ subroutine psb_s_map_Y2X(alpha,x,beta,y,map,info,work)
end if
if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_X,info)
if (info /= psb_success_) then
write(0,*) trim(name),' Error from inner routines',info
write(psb_err_unit,*) trim(name),' Error from inner routines',info
info = -1
end if
@ -170,13 +170,13 @@ subroutine psb_s_map_Y2X(alpha,x,beta,y,map,info,work)
end if
if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_X,info)
if (info /= psb_success_) then
write(0,*) trim(name),' Error from inner routines',info
write(psb_err_unit,*) trim(name),' Error from inner routines',info
info = -1
end if
case default
write(0,*) trim(name),' Invalid descriptor input'
write(psb_err_unit,*) trim(name),' Invalid descriptor input'
info = 1
return
end select
@ -207,7 +207,7 @@ subroutine psb_d_map_X2Y(alpha,x,beta,y,map,info,work)
info = psb_success_
if (.not.psb_is_asb_map(map)) then
write(0,*) trim(name),' Invalid descriptor input: unassembled'
write(psb_err_unit,*) trim(name),' Invalid descriptor input: unassembled'
info = 1
return
end if
@ -228,7 +228,7 @@ subroutine psb_d_map_X2Y(alpha,x,beta,y,map,info,work)
end if
if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_Y,info)
if (info /= psb_success_) then
write(0,*) trim(name),' Error from inner routines',info
write(psb_err_unit,*) trim(name),' Error from inner routines',info
info = -1
end if
@ -248,13 +248,13 @@ subroutine psb_d_map_X2Y(alpha,x,beta,y,map,info,work)
end if
if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_Y,info)
if (info /= psb_success_) then
write(0,*) trim(name),' Error from inner routines',info
write(psb_err_unit,*) trim(name),' Error from inner routines',info
info = -1
end if
case default
write(0,*) trim(name),' Invalid descriptor input', &
write(psb_err_unit,*) trim(name),' Invalid descriptor input', &
& map_kind, psb_map_aggr_, psb_map_gen_linear_
info = 1
return
@ -287,7 +287,7 @@ subroutine psb_d_map_Y2X(alpha,x,beta,y,map,info,work)
info = psb_success_
if (.not.psb_is_asb_map(map)) then
write(0,*) trim(name),' Invalid descriptor input'
write(psb_err_unit,*) trim(name),' Invalid descriptor input'
info = 1
return
end if
@ -308,7 +308,7 @@ subroutine psb_d_map_Y2X(alpha,x,beta,y,map,info,work)
end if
if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_X,info)
if (info /= psb_success_) then
write(0,*) trim(name),' Error from inner routines',info
write(psb_err_unit,*) trim(name),' Error from inner routines',info
info = -1
end if
@ -328,13 +328,13 @@ subroutine psb_d_map_Y2X(alpha,x,beta,y,map,info,work)
end if
if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_X,info)
if (info /= psb_success_) then
write(0,*) trim(name),' Error from inner routines',info
write(psb_err_unit,*) trim(name),' Error from inner routines',info
info = -1
end if
case default
write(0,*) trim(name),' Invalid descriptor input'
write(psb_err_unit,*) trim(name),' Invalid descriptor input'
info = 1
return
end select
@ -366,7 +366,7 @@ subroutine psb_c_map_X2Y(alpha,x,beta,y,map,info,work)
info = psb_success_
if (.not.psb_is_asb_map(map)) then
write(0,*) trim(name),' Invalid descriptor input'
write(psb_err_unit,*) trim(name),' Invalid descriptor input'
info = 1
return
end if
@ -387,7 +387,7 @@ subroutine psb_c_map_X2Y(alpha,x,beta,y,map,info,work)
end if
if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_Y,info)
if (info /= psb_success_) then
write(0,*) trim(name),' Error from inner routines',info
write(psb_err_unit,*) trim(name),' Error from inner routines',info
info = -1
end if
@ -407,13 +407,13 @@ subroutine psb_c_map_X2Y(alpha,x,beta,y,map,info,work)
end if
if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_Y,info)
if (info /= psb_success_) then
write(0,*) trim(name),' Error from inner routines',info
write(psb_err_unit,*) trim(name),' Error from inner routines',info
info = -1
end if
case default
write(0,*) trim(name),' Invalid descriptor input'
write(psb_err_unit,*) trim(name),' Invalid descriptor input'
info = 1
return
end select
@ -445,7 +445,7 @@ subroutine psb_c_map_Y2X(alpha,x,beta,y,map,info,work)
info = psb_success_
if (.not.psb_is_asb_map(map)) then
write(0,*) trim(name),' Invalid descriptor input'
write(psb_err_unit,*) trim(name),' Invalid descriptor input'
info = 1
return
end if
@ -466,7 +466,7 @@ subroutine psb_c_map_Y2X(alpha,x,beta,y,map,info,work)
end if
if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_X,info)
if (info /= psb_success_) then
write(0,*) trim(name),' Error from inner routines',info
write(psb_err_unit,*) trim(name),' Error from inner routines',info
info = -1
end if
@ -486,13 +486,13 @@ subroutine psb_c_map_Y2X(alpha,x,beta,y,map,info,work)
end if
if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_X,info)
if (info /= psb_success_) then
write(0,*) trim(name),' Error from inner routines',info
write(psb_err_unit,*) trim(name),' Error from inner routines',info
info = -1
end if
case default
write(0,*) trim(name),' Invalid descriptor input'
write(psb_err_unit,*) trim(name),' Invalid descriptor input'
info = 1
return
end select
@ -524,7 +524,7 @@ subroutine psb_z_map_X2Y(alpha,x,beta,y,map,info,work)
info = psb_success_
if (.not.psb_is_asb_map(map)) then
write(0,*) trim(name),' Invalid descriptor input'
write(psb_err_unit,*) trim(name),' Invalid descriptor input'
info = 1
return
end if
@ -545,7 +545,7 @@ subroutine psb_z_map_X2Y(alpha,x,beta,y,map,info,work)
end if
if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_Y,info)
if (info /= psb_success_) then
write(0,*) trim(name),' Error from inner routines',info
write(psb_err_unit,*) trim(name),' Error from inner routines',info
info = -1
end if
@ -565,13 +565,13 @@ subroutine psb_z_map_X2Y(alpha,x,beta,y,map,info,work)
end if
if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_Y,info)
if (info /= psb_success_) then
write(0,*) trim(name),' Error from inner routines',info
write(psb_err_unit,*) trim(name),' Error from inner routines',info
info = -1
end if
case default
write(0,*) trim(name),' Invalid descriptor input'
write(psb_err_unit,*) trim(name),' Invalid descriptor input'
info = 1
return
end select
@ -603,7 +603,7 @@ subroutine psb_z_map_Y2X(alpha,x,beta,y,map,info,work)
info = psb_success_
if (.not.psb_is_asb_map(map)) then
write(0,*) trim(name),' Invalid descriptor input'
write(psb_err_unit,*) trim(name),' Invalid descriptor input'
info = 1
return
end if
@ -624,7 +624,7 @@ subroutine psb_z_map_Y2X(alpha,x,beta,y,map,info,work)
end if
if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%p_desc_X,info)
if (info /= psb_success_) then
write(0,*) trim(name),' Error from inner routines',info
write(psb_err_unit,*) trim(name),' Error from inner routines',info
info = -1
end if
@ -644,13 +644,13 @@ subroutine psb_z_map_Y2X(alpha,x,beta,y,map,info,work)
end if
if (info == psb_success_) call psb_geaxpby(alpha,yt,beta,y,map%desc_X,info)
if (info /= psb_success_) then
write(0,*) trim(name),' Error from inner routines',info
write(psb_err_unit,*) trim(name),' Error from inner routines',info
info = -1
end if
case default
write(0,*) trim(name),' Invalid descriptor input'
write(psb_err_unit,*) trim(name),' Invalid descriptor input'
info = 1
return
end select

2
base/tools/psb_scdbldext.F90
Unescape Escape View File

@ -550,7 +550,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
Do i=1,iszr
idx=workr(i)
if (idx <1) then
write(0,*) me,'Error in CDBLDEXTBLD level',i_ovr,' : ',idx,i,iszr
write(psb_err_unit,*) me,'Error in CDBLDEXTBLD level',i_ovr,' : ',idx,i,iszr
else If (desc_ov%idxmap%glob_to_loc(idx) < -np) Then
!
! This is a new index. Assigning a local index as

2
base/tools/psb_sspins.f90
Unescape Escape View File

@ -326,7 +326,7 @@ subroutine psb_sspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
else if (psb_is_asb_desc(desc_ac)) then
write(0,*) 'Why are you calling me on an assembled desc_ac?'
write(psb_err_unit,*) 'Why are you calling me on an assembled desc_ac?'
!!$ if (psb_is_large_desc(desc_a)) then
!!$
!!$ allocate(ila(nz),jla(nz),stat=info)

2
base/tools/psb_zcdbldext.F90
Unescape Escape View File

@ -550,7 +550,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
Do i=1,iszr
idx=workr(i)
if (idx <1) then
write(0,*) me,'Error in CDBLDEXTBLD level',i_ovr,' : ',idx,i,iszr
write(psb_err_unit,*) me,'Error in CDBLDEXTBLD level',i_ovr,' : ',idx,i,iszr
else If (desc_ov%idxmap%glob_to_loc(idx) < -np) Then
!
! This is a new index. Assigning a local index as

2
base/tools/psb_zspins.f90
Unescape Escape View File

@ -326,7 +326,7 @@ subroutine psb_zspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
else if (psb_is_asb_desc(desc_ac)) then
write(0,*) 'Why are you calling me on an assembled desc_ac?'
write(psb_err_unit,*) 'Why are you calling me on an assembled desc_ac?'
!!$ if (psb_is_large_desc(desc_a)) then
!!$
!!$ allocate(ila(nz),jla(nz),stat=info)

33
config/pac.m4
Unescape Escape View File

@ -1314,3 +1314,36 @@ ifelse([$2], , , [
fi
cd ..
rm -fr tmpdir_$i])
dnl @synopsis PAC_FORTRAN_TEST_ISO_FORTRAN_ENV( [ACTION-IF-FOUND [, ACTION-IF-NOT-FOUND]])
dnl
dnl Will determine if the fortran compiler MPIFC supports ISO_FORTRAN_ENV
dnl
dnl If yes, will execute ACTION-IF-FOUND. Otherwise, ACTION-IF-NOT-FOUND.
dnl
dnl @author Salvatore Filippone <salvatore.filippone@uniroma2.it>
dnl
AC_DEFUN(PAC_FORTRAN_TEST_ISO_FORTRAN_ENV,
ac_exeext=''
ac_ext='f90'
ac_link='${MPIFC-$FC} -o conftest${ac_exeext} $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
dnl Warning : square brackets are EVIL!
[AC_MSG_CHECKING([support for ISO_FORTRAN_ENV])
cat > conftest.$ac_ext <<EOF
program test
use iso_fortran_env
end program test
EOF
if AC_TRY_EVAL(ac_link) && test -s conftest${ac_exeext}; then
AC_MSG_RESULT([yes])
ifelse([$1], , :, [rm -rf conftest*
$1])
else
echo "configure: failed program was:" >&AC_FD_CC
cat conftest.$ac_ext >&AC_FD_CC
AC_MSG_RESULT([no])
ifelse([$2], , , [ rm -rf conftest*
$2
])dnl
fi
rm -f conftest*])

28
configure vendored
Unescape Escape View File

@ -7657,6 +7657,34 @@ fi
cd ..
rm -fr tmpdir_$i
ac_exeext=''
ac_ext='f90'
ac_link='${MPIFC-$FC} -o conftest${ac_exeext} $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
{ $as_echo "$as_me:$LINENO: checking support for ISO_FORTRAN_ENV" >&5
$as_echo_n "checking support for ISO_FORTRAN_ENV... " >&6; }
cat > conftest.$ac_ext <<EOF
program test
use iso_fortran_env
end program test
EOF
if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
(eval $ac_link) 2>&5
ac_status=$?
$as_echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); } && test -s conftest${ac_exeext}; then
{ $as_echo "$as_me:$LINENO: result: yes" >&5
$as_echo "yes" >&6; }
rm -rf conftest*
FDEFINES="$psblas_cv_define_prepend-DHAVE_ISO_FORTRAN_ENV $FDEFINES"
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
{ $as_echo "$as_me:$LINENO: result: no" >&5
$as_echo "no" >&6; }
fi
rm -f conftest*
ac_exeext=''
ac_ext='f90'
ac_link='${MPIFC-$FC} -o conftest${ac_exeext} $FCFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'

5
configure.ac
Unescape Escape View File

@ -539,6 +539,11 @@ PAC_FORTRAN_TEST_FLUSH(
[FDEFINES="$psblas_cv_define_prepend-DHAVE_FLUSH_STMT $FDEFINES"],
)
PAC_FORTRAN_TEST_ISO_FORTRAN_ENV(
[FDEFINES="$psblas_cv_define_prepend-DHAVE_ISO_FORTRAN_ENV $FDEFINES"],
)
PAC_FORTRAN_TEST_FINAL(
[FDEFINES="$psblas_cv_define_prepend-DHAVE_FINAL $FDEFINES"],
)

14
krylov/psb_base_inner_krylov_mod.f90
Unescape Escape View File

@ -64,7 +64,7 @@ contains
mname = adjustl(trim(methdname))
write(outname,'(a)') mname(1:min(len_trim(mname),outlen-1))//':'
write(*,fmt) adjustl(outname),'Iteration','Error Estimate','Tolerance'
write(psb_out_unit,fmt) adjustl(outname),'Iteration','Error Estimate','Tolerance'
end subroutine log_header
@ -84,9 +84,9 @@ contains
mname = adjustl(trim(methdname))
write(outname,'(a)') mname(1:min(len_trim(mname),outlen-1))//':'
if (errden > dzero ) then
write(*,fmt) adjustl(outname),itx,errnum/errden,eps
write(psb_out_unit,fmt) adjustl(outname),itx,errnum/errden,eps
else
write(*,fmt) adjustl(outname),itx,errnum,eps
write(psb_out_unit,fmt) adjustl(outname),itx,errnum,eps
end if
endif
@ -107,9 +107,9 @@ contains
if (errden == dzero) then
if (errnum > eps) then
if (me == 0) then
write(*,fmt) trim(methdname)//' failed to converge to ',eps,&
write(psb_out_unit,fmt) trim(methdname)//' failed to converge to ',eps,&
& ' in ',it,' iterations. '
write(*,fmt1) 'Last iteration error estimate: ',&
write(psb_out_unit,fmt1) 'Last iteration error estimate: ',&
& errnum
end if
end if
@ -117,9 +117,9 @@ contains
else
if (errnum/errden > eps) then
if (me == 0) then
write(*,fmt) trim(methdname)//' failed to converge to ',eps,&
write(psb_out_unit,fmt) trim(methdname)//' failed to converge to ',eps,&
& ' in ',it,' iterations. '
write(*,fmt1) 'Last iteration error estimate: ',&
write(psb_out_unit,fmt1) 'Last iteration error estimate: ',&
& errnum/errden
end if
endif

2
krylov/psb_ckrylov.f90
Unescape Escape View File

@ -221,7 +221,7 @@ Subroutine psb_ckrylov(method,a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,i
call psb_ccgstabl(a,prec,b,x,eps,desc_a,info,&
&itmax,iter,err,itrace,irst,istop)
case default
if (me == 0) write(0,*) trim(name),': Warning: Unknown method ',method,&
if (me == 0) write(psb_err_unit,*) trim(name),': Warning: Unknown method ',method,&
& ', defaulting to BiCGSTAB'
call psb_ccgstab(a,prec,b,x,eps,desc_a,info,&
&itmax,iter,err,itrace,istop)

2
krylov/psb_dkrylov.f90
Unescape Escape View File

@ -219,7 +219,7 @@ Subroutine psb_dkrylov(method,a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,i
call psb_dcgstabl(a,prec,b,x,eps,desc_a,info,&
&itmax,iter,err,itrace,irst,istop)
case default
if (me == 0) write(0,*) trim(name),': Warning: Unknown method ',method,&
if (me == 0) write(psb_err_unit,*) trim(name),': Warning: Unknown method ',method,&
& ', defaulting to BiCGSTAB'
call psb_dcgstab(a,prec,b,x,eps,desc_a,info,&
&itmax,iter,err,itrace,istop)

2
krylov/psb_skrylov.f90
Unescape Escape View File

@ -222,7 +222,7 @@ Subroutine psb_skrylov(method,a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,i
call psb_scgstabl(a,prec,b,x,eps,desc_a,info,&
&itmax,iter,err,itrace,irst,istop)
case default
if (me == 0) write(0,*) trim(name),': Warning: Unknown method ',method,&
if (me == 0) write(psb_err_unit,*) trim(name),': Warning: Unknown method ',method,&
& ', defaulting to BiCGSTAB'
call psb_scgstab(a,prec,b,x,eps,desc_a,info,&
&itmax,iter,err,itrace,istop)

2
krylov/psb_zkrylov.f90
Unescape Escape View File

@ -220,7 +220,7 @@ Subroutine psb_zkrylov(method,a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,i
call psb_zcgstabl(a,prec,b,x,eps,desc_a,info,&
&itmax,iter,err,itrace,irst,istop)
case default
if (me == 0) write(0,*) trim(name),': Warning: Unknown method ',method,&
if (me == 0) write(psb_err_unit,*) trim(name),': Warning: Unknown method ',method,&
& ', defaulting to BiCGSTAB'
call psb_zcgstab(a,prec,b,x,eps,desc_a,info,&
&itmax,iter,err,itrace,istop)

6
prec/psb_c_bjacprec.f03
Unescape Escape View File

@ -382,7 +382,7 @@ contains
select case(what)
case (psb_f_type_)
if (prec%iprcparm(psb_p_type_) /= psb_bjac_) then
write(0,*) 'WHAT is invalid for current preconditioner ',prec%iprcparm(psb_p_type_),&
write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',prec%iprcparm(psb_p_type_),&
& 'ignoring user specification'
return
endif
@ -390,14 +390,14 @@ contains
case (psb_ilu_fill_in_)
if ((prec%iprcparm(psb_p_type_) /= psb_bjac_).or.(prec%iprcparm(psb_f_type_) /= psb_f_ilu_n_)) then
write(0,*) 'WHAT is invalid for current preconditioner ',prec%iprcparm(psb_p_type_),&
write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',prec%iprcparm(psb_p_type_),&
& 'ignoring user specification'
return
endif
prec%iprcparm(psb_ilu_fill_in_) = val
case default
write(0,*) 'WHAT is invalid, ignoring user specification'
write(psb_err_unit,*) 'WHAT is invalid, ignoring user specification'
end select

10
prec/psb_cilu_fct.f90
Unescape Escape View File

@ -156,7 +156,7 @@ contains
type is (psb_c_csr_sparse_mat)
do j = aa%irp(i), aa%irp(i+1) - 1
k = aa%ja(j)
! write(0,*)'KKKKK',k
! write(psb_err_unit,*)'KKKKK',k
if ((k < i).and.(k >= 1)) then
l1 = l1 + 1
laspk(l1) = aa%val(j)
@ -238,9 +238,9 @@ contains
!
else if (j == i) then
! j=i update diagonal
! write(0,*)'aggiorno dia',dia,'temp',temp,'jj',jj,'u%aspk',uaspk(jj)
! write(psb_err_unit,*)'aggiorno dia',dia,'temp',temp,'jj',jj,'u%aspk',uaspk(jj)
dia = dia - temp*uaspk(jj)
! write(0,*)'dia',dia,'temp',temp,'jj',jj,'aspk',uaspk(jj)
! write(psb_err_unit,*)'dia',dia,'temp',temp,'jj',jj,'aspk',uaspk(jj)
cycle updateloop
!
else if (j > i) then
@ -280,7 +280,7 @@ contains
dia = cone/dia
end if
d(i) = dia
! write(6,*)'diag(',i,')=',d(i)
! write(psb_err_unit,*)'diag(',i,')=',d(i)
! Scale row i of upper triangle
do kk = uia2(i), uia2(i+1) - 1
uaspk(kk) = uaspk(kk)*dia
@ -294,7 +294,7 @@ contains
type is (psb_c_csr_sparse_mat)
do j = aa%irp(i-ma), aa%irp(i-ma+1) - 1
k = aa%ja(j)
! write(0,*)'KKKKK',k
! write(psb_err_unit,*)'KKKKK',k
if ((k < i).and.(k >= 1)) then
l1 = l1 + 1
laspk(l1) = aa%val(j)

2
prec/psb_cprecinit.f90
Unescape Escape View File

@ -62,7 +62,7 @@ subroutine psb_cprecinit(p,ptype,info)
allocate(psb_c_bjac_prec_type :: p%prec, stat=info)
case default
write(0,*) 'Unknown preconditioner type request "',ptype,'"'
write(psb_err_unit,*) 'Unknown preconditioner type request "',ptype,'"'
info = psb_err_pivot_too_small_
end select

6
prec/psb_d_bjacprec.f03
Unescape Escape View File

@ -376,7 +376,7 @@ contains
select case(what)
case (psb_f_type_)
if (prec%iprcparm(psb_p_type_) /= psb_bjac_) then
write(0,*) 'WHAT is invalid for current preconditioner ',prec%iprcparm(psb_p_type_),&
write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',prec%iprcparm(psb_p_type_),&
& 'ignoring user specification'
return
endif
@ -384,14 +384,14 @@ contains
case (psb_ilu_fill_in_)
if ((prec%iprcparm(psb_p_type_) /= psb_bjac_).or.(prec%iprcparm(psb_f_type_) /= psb_f_ilu_n_)) then
write(0,*) 'WHAT is invalid for current preconditioner ',prec%iprcparm(psb_p_type_),&
write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',prec%iprcparm(psb_p_type_),&
& 'ignoring user specification'
return
endif
prec%iprcparm(psb_ilu_fill_in_) = val
case default
write(0,*) 'WHAT is invalid, ignoring user specification'
write(psb_err_unit,*) 'WHAT is invalid, ignoring user specification'
end select

10
prec/psb_dilu_fct.f90
Unescape Escape View File

@ -159,7 +159,7 @@ contains
type is (psb_d_csr_sparse_mat)
do j = aa%irp(i), aa%irp(i+1) - 1
k = aa%ja(j)
! write(0,*)'KKKKK',k
! write(psb_err_unit,*)'KKKKK',k
if ((k < i).and.(k >= 1)) then
l1 = l1 + 1
laspk(l1) = aa%val(j)
@ -241,9 +241,9 @@ contains
!
else if (j == i) then
! j=i update diagonal
! write(0,*)'aggiorno dia',dia,'temp',temp,'jj',jj,'u%aspk',uaspk(jj)
! write(psb_err_unit,*)'aggiorno dia',dia,'temp',temp,'jj',jj,'u%aspk',uaspk(jj)
dia = dia - temp*uaspk(jj)
! write(0,*)'dia',dia,'temp',temp,'jj',jj,'aspk',uaspk(jj)
! write(psb_err_unit,*)'dia',dia,'temp',temp,'jj',jj,'aspk',uaspk(jj)
cycle updateloop
!
else if (j > i) then
@ -283,7 +283,7 @@ contains
dia = done/dia
end if
d(i) = dia
! write(6,*)'diag(',i,')=',d(i)
! write(psb_err_unit,*)'diag(',i,')=',d(i)
! Scale row i of upper triangle
do kk = uia2(i), uia2(i+1) - 1
uaspk(kk) = uaspk(kk)*dia
@ -297,7 +297,7 @@ contains
type is (psb_d_csr_sparse_mat)
do j = aa%irp(i-ma), aa%irp(i-ma+1) - 1
k = aa%ja(j)
! write(0,*)'KKKKK',k
! write(psb_err_unit,*)'KKKKK',k
if ((k < i).and.(k >= 1)) then
l1 = l1 + 1
laspk(l1) = aa%val(j)

2
prec/psb_dprecinit.f90
Unescape Escape View File

@ -61,7 +61,7 @@ subroutine psb_dprecinit(p,ptype,info)
allocate(psb_d_bjac_prec_type :: p%prec, stat=info)
case default
write(0,*) 'Unknown preconditioner type request "',ptype,'"'
write(psb_err_unit,*) 'Unknown preconditioner type request "',ptype,'"'
info = psb_err_pivot_too_small_
end select

9
prec/psb_prec_const_mod.f03
Unescape Escape View File

@ -35,7 +35,8 @@
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
module psb_prec_const_mod
use psb_sparse_mod, only : psb_dpk_, psb_spk_, psb_long_int_k_
use psb_sparse_mod, only : psb_dpk_, psb_spk_, psb_long_int_k_,&
& psb_err_unit, psb_inp_unit, psb_out_unit
integer, parameter :: psb_min_prec_=0, psb_noprec_=0, psb_diag_=1, &
& psb_bjac_=2, psb_max_prec_=2
@ -121,7 +122,7 @@ contains
end interface
if (.not.is_legal(ip)) then
write(0,*) 'Illegal value for ',name,' :',ip, '. defaulting to ',id
write(psb_err_unit,*) 'Illegal value for ',name,' :',ip, '. defaulting to ',id
ip = id
end if
end subroutine psb_icheck_def
@ -139,7 +140,7 @@ contains
end interface
if (.not.is_legal(ip)) then
write(0,*) 'Illegal value for ',name,' :',ip, '. defaulting to ',id
write(psb_err_unit,*) 'Illegal value for ',name,' :',ip, '. defaulting to ',id
ip = id
end if
end subroutine psb_scheck_def
@ -157,7 +158,7 @@ contains
end interface
if (.not.is_legal(ip)) then
write(0,*) 'Illegal value for ',name,' :',ip, '. defaulting to ',id
write(psb_err_unit,*) 'Illegal value for ',name,' :',ip, '. defaulting to ',id
ip = id
end if
end subroutine psb_dcheck_def

6
prec/psb_s_bjacprec.f03
Unescape Escape View File

@ -376,7 +376,7 @@ contains
select case(what)
case (psb_f_type_)
if (prec%iprcparm(psb_p_type_) /= psb_bjac_) then
write(0,*) 'WHAT is invalid for current preconditioner ',prec%iprcparm(psb_p_type_),&
write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',prec%iprcparm(psb_p_type_),&
& 'ignoring user specification'
return
endif
@ -384,14 +384,14 @@ contains
case (psb_ilu_fill_in_)
if ((prec%iprcparm(psb_p_type_) /= psb_bjac_).or.(prec%iprcparm(psb_f_type_) /= psb_f_ilu_n_)) then
write(0,*) 'WHAT is invalid for current preconditioner ',prec%iprcparm(psb_p_type_),&
write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',prec%iprcparm(psb_p_type_),&
& 'ignoring user specification'
return
endif
prec%iprcparm(psb_ilu_fill_in_) = val
case default
write(0,*) 'WHAT is invalid, ignoring user specification'
write(psb_err_unit,*) 'WHAT is invalid, ignoring user specification'
end select

10
prec/psb_silu_fct.f90
Unescape Escape View File

@ -158,7 +158,7 @@ contains
type is (psb_s_csr_sparse_mat)
do j = aa%irp(i), aa%irp(i+1) - 1
k = aa%ja(j)
! write(0,*)'KKKKK',k
! write(psb_err_unit,*)'KKKKK',k
if ((k < i).and.(k >= 1)) then
l1 = l1 + 1
laspk(l1) = aa%val(j)
@ -240,9 +240,9 @@ contains
!
else if (j == i) then
! j=i update diagonal
! write(0,*)'aggiorno dia',dia,'temp',temp,'jj',jj,'u%aspk',uaspk(jj)
! write(psb_err_unit,*)'aggiorno dia',dia,'temp',temp,'jj',jj,'u%aspk',uaspk(jj)
dia = dia - temp*uaspk(jj)
! write(0,*)'dia',dia,'temp',temp,'jj',jj,'aspk',uaspk(jj)
! write(psb_err_unit,*)'dia',dia,'temp',temp,'jj',jj,'aspk',uaspk(jj)
cycle updateloop
!
else if (j > i) then
@ -282,7 +282,7 @@ contains
dia = sone/dia
end if
d(i) = dia
! write(6,*)'diag(',i,')=',d(i)
! write(psb_err_unit,*)'diag(',i,')=',d(i)
! Scale row i of upper triangle
do kk = uia2(i), uia2(i+1) - 1
uaspk(kk) = uaspk(kk)*dia
@ -296,7 +296,7 @@ contains
type is (psb_s_csr_sparse_mat)
do j = aa%irp(i-ma), aa%irp(i-ma+1) - 1
k = aa%ja(j)
! write(0,*)'KKKKK',k
! write(psb_err_unit,*)'KKKKK',k
if ((k < i).and.(k >= 1)) then
l1 = l1 + 1
laspk(l1) = aa%val(j)

2
prec/psb_sprecinit.f90
Unescape Escape View File

@ -61,7 +61,7 @@ subroutine psb_sprecinit(p,ptype,info)
allocate(psb_s_bjac_prec_type :: p%prec, stat=info)
case default
write(0,*) 'Unknown preconditioner type request "',ptype,'"'
write(psb_err_unit,*) 'Unknown preconditioner type request "',ptype,'"'
info = psb_err_pivot_too_small_
end select

6
prec/psb_z_bjacprec.f03
Unescape Escape View File

@ -382,7 +382,7 @@ contains
select case(what)
case (psb_f_type_)
if (prec%iprcparm(psb_p_type_) /= psb_bjac_) then
write(0,*) 'WHAT is invalid for current preconditioner ',prec%iprcparm(psb_p_type_),&
write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',prec%iprcparm(psb_p_type_),&
& 'ignoring user specification'
return
endif
@ -390,14 +390,14 @@ contains
case (psb_ilu_fill_in_)
if ((prec%iprcparm(psb_p_type_) /= psb_bjac_).or.(prec%iprcparm(psb_f_type_) /= psb_f_ilu_n_)) then
write(0,*) 'WHAT is invalid for current preconditioner ',prec%iprcparm(psb_p_type_),&
write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',prec%iprcparm(psb_p_type_),&
& 'ignoring user specification'
return
endif
prec%iprcparm(psb_ilu_fill_in_) = val
case default
write(0,*) 'WHAT is invalid, ignoring user specification'
write(psb_err_unit,*) 'WHAT is invalid, ignoring user specification'
end select

10
prec/psb_zilu_fct.f90
Unescape Escape View File

@ -156,7 +156,7 @@ contains
type is (psb_z_csr_sparse_mat)
do j = aa%irp(i), aa%irp(i+1) - 1
k = aa%ja(j)
! write(0,*)'KKKKK',k
! write(psb_err_unit,*)'KKKKK',k
if ((k < i).and.(k >= 1)) then
l1 = l1 + 1
laspk(l1) = aa%val(j)
@ -238,9 +238,9 @@ contains
!
else if (j == i) then
! j=i update diagonal
! write(0,*)'aggiorno dia',dia,'temp',temp,'jj',jj,'u%aspk',uaspk(jj)
! write(psb_err_unit,*)'aggiorno dia',dia,'temp',temp,'jj',jj,'u%aspk',uaspk(jj)
dia = dia - temp*uaspk(jj)
! write(0,*)'dia',dia,'temp',temp,'jj',jj,'aspk',uaspk(jj)
! write(psb_err_unit,*)'dia',dia,'temp',temp,'jj',jj,'aspk',uaspk(jj)
cycle updateloop
!
else if (j > i) then
@ -280,7 +280,7 @@ contains
dia = zone/dia
end if
d(i) = dia
! write(6,*)'diag(',i,')=',d(i)
! write(psb_err_unit,*)'diag(',i,')=',d(i)
! Scale row i of upper triangle
do kk = uia2(i), uia2(i+1) - 1
uaspk(kk) = uaspk(kk)*dia
@ -294,7 +294,7 @@ contains
type is (psb_z_csr_sparse_mat)
do j = aa%irp(i-ma), aa%irp(i-ma+1) - 1
k = aa%ja(j)
! write(0,*)'KKKKK',k
! write(psb_err_unit,*)'KKKKK',k
if ((k < i).and.(k >= 1)) then
l1 = l1 + 1
laspk(l1) = aa%val(j)

2
prec/psb_zprecinit.f90
Unescape Escape View File

@ -62,7 +62,7 @@ subroutine psb_zprecinit(p,ptype,info)
allocate(psb_z_bjac_prec_type :: p%prec, stat=info)
case default
write(0,*) 'Unknown preconditioner type request "',ptype,'"'
write(psb_err_unit,*) 'Unknown preconditioner type request "',ptype,'"'
info = psb_err_pivot_too_small_
end select

64
test/fileread/cf_sample.f90
Unescape Escape View File

@ -122,10 +122,10 @@ program cf_sample
case default
info = -1
write(0,*) 'Wrong choice for fileformat ', filefmt
write(psb_err_unit,*) 'Wrong choice for fileformat ', filefmt
end select
if (info /= psb_success_) then
write(0,*) 'Error while reading input matrix '
write(psb_err_unit,*) 'Error while reading input matrix '
call psb_abort(ictxt)
end if
@ -135,11 +135,11 @@ program cf_sample
! At this point aux_b may still be unallocated
if (psb_size(aux_b,dim=1) == m_problem) then
! if any rhs were present, broadcast the first one
write(0,'("Ok, got an rhs ")')
write(psb_err_unit,'("Ok, got an rhs ")')
b_col_glob =>aux_b(:,1)
else
write(*,'("Generating an rhs...")')
write(*,'(" ")')
write(psb_out_unit,'("Generating an rhs...")')
write(psb_out_unit,'(" ")')
call psb_realloc(m_problem,1,aux_b,ircode)
if (ircode /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,name)
@ -166,7 +166,7 @@ program cf_sample
! switch over different partition types
if (ipart == 0) then
call psb_barrier(ictxt)
if (iam == psb_root_) write(*,'("Partition type: block")')
if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")')
allocate(ivg(m_problem),ipv(np))
do i=1,m_problem
call part_block(i,m_problem,np,ipv,nv)
@ -176,9 +176,9 @@ program cf_sample
& desc_a,b_col_glob,b_col,info,fmt=afmt,v=ivg)
else if (ipart == 2) then
if (iam == psb_root_) then
write(*,'("Partition type: graph")')
write(*,'(" ")')
! write(0,'("Build type: graph")')
write(psb_out_unit,'("Partition type: graph")')
write(psb_out_unit,'(" ")')
! write(psb_err_unit,'("Build type: graph")')
call build_mtpart(aux_a,np)
endif
@ -188,7 +188,7 @@ program cf_sample
call psb_matdist(aux_a, a, ictxt, &
& desc_a,b_col_glob,b_col,info,fmt=afmt,v=ivg)
else
if (iam == psb_root_) write(*,'("Partition type: block")')
if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")')
call psb_matdist(aux_a, a, ictxt, &
& desc_a,b_col_glob,b_col,info,fmt=afmt,parts=part_block)
end if
@ -205,9 +205,9 @@ program cf_sample
call psb_amx(ictxt, t2)
if (iam == psb_root_) then
write(*,'(" ")')
write(*,'("Time to read and partition matrix : ",es12.5)')t2
write(*,'(" ")')
write(psb_out_unit,'(" ")')
write(psb_out_unit,'("Time to read and partition matrix : ",es12.5)')t2
write(psb_out_unit,'(" ")')
end if
!
@ -227,8 +227,8 @@ program cf_sample
call psb_amx(ictxt,tprec)
if(iam == psb_root_) then
write(*,'("Preconditioner time: ",es12.5)')tprec
write(*,'(" ")')
write(psb_out_unit,'("Preconditioner time: ",es12.5)')tprec
write(psb_out_unit,'(" ")')
end if
iparm = 0
@ -252,31 +252,31 @@ program cf_sample
call psb_sum(ictxt,precsize)
if (iam == psb_root_) then
call psb_precdescr(prec)
write(*,'("Matrix: ",a)')mtrx_file
write(*,'("Computed solution on ",i8," processors")')np
write(*,'("Iterations to convergence: ",i6)')iter
write(*,'("Error estimate on exit : ",es12.5)') err
write(*,'("Time to buil prec. : ",es12.5)')tprec
write(*,'("Time to solve matrix : ",es12.5)')t2
write(*,'("Time per iteration : ",es12.5)')t2/(iter)
write(*,'("Total time : ",es12.5)')t2+tprec
write(*,'("Residual norm 2 : ",es12.5)')resmx
write(*,'("Residual norm inf : ",es12.5)')resmxp
!!$ write(*,*)"Condition number : ",cond
write(*,'("Total memory occupation for A: ",i12)')amatsize
write(*,'("Total memory occupation for DESC_A: ",i12)')descsize
write(*,'("Total memory occupation for PREC: ",i12)')precsize
write(psb_out_unit,'("Matrix: ",a)')mtrx_file
write(psb_out_unit,'("Computed solution on ",i8," processors")')np
write(psb_out_unit,'("Iterations to convergence: ",i6)')iter
write(psb_out_unit,'("Error estimate on exit : ",es12.5)') err
write(psb_out_unit,'("Time to buil prec. : ",es12.5)')tprec
write(psb_out_unit,'("Time to solve matrix : ",es12.5)')t2
write(psb_out_unit,'("Time per iteration : ",es12.5)')t2/(iter)
write(psb_out_unit,'("Total time : ",es12.5)')t2+tprec
write(psb_out_unit,'("Residual norm 2 : ",es12.5)')resmx
write(psb_out_unit,'("Residual norm inf : ",es12.5)')resmxp
!!$ write(psb_out_unit,*)"Condition number : ",cond
write(psb_out_unit,'("Total memory occupation for A: ",i12)')amatsize
write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize
write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize
end if
allocate(x_col_glob(m_problem),r_col_glob(m_problem),stat=ierr)
if (ierr /= 0) then
write(0,*) 'allocation error: no data collection'
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(0,'(" ")')
write(0,'("Saving x on file")')
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

Some files were not shown because too many files have changed in this diff Show More

Write Preview
Loading…
Cancel
Save