diff --git a/src/tools/psb_dcdovr.f90 b/src/tools/psb_dcdovr.f90 index 889e61e9..292f0a6c 100644 --- a/src/tools/psb_dcdovr.f90 +++ b/src/tools/psb_dcdovr.f90 @@ -126,7 +126,7 @@ Subroutine psb_dcdovr(a,desc_a,novr,desc_ov,info) ! if (debug) write(0,*) 'Calling desccpy' call psb_cdcpy(desc_a,desc_ov,info) - if (info.ne.0) then + if (info /= 0) then info=4010 ch_err='psb_cdcpy' call psb_errpush(info,name,a_err=ch_err) @@ -161,7 +161,7 @@ Subroutine psb_dcdovr(a,desc_a,novr,desc_ov,info) ! nonzeros per row is the same as the global. ! call psb_spinfo(psb_nztotreq_,a,nztot,info) - if (info.ne.0) then + if (info /= 0) then info=4010 ch_err='psb_spinfo' call psb_errpush(info,name,a_err=ch_err) @@ -184,7 +184,7 @@ Subroutine psb_dcdovr(a,desc_a,novr,desc_ov,info) & desc_ov%ovrlap_elem(novr*(Max(elem_dim,1)+3)),& & desc_ov%matrix_data(psb_mdata_size_),& & desc_ov%halo_index(novr*(Size(desc_a%halo_index)+3)),STAT=INFO) - if (info.ne.0) then + if (info /= 0) then info=4000 call psb_errpush(info,name) goto 9999 @@ -200,7 +200,12 @@ Subroutine psb_dcdovr(a,desc_a,novr,desc_ov,info) desc_ov%matrix_data(psb_dec_type_) = psb_desc_bld_ Allocate(desc_ov%loc_to_glob(Size(desc_a%loc_to_glob)),& - & desc_ov%glob_to_loc(Size(desc_a%glob_to_loc))) + & desc_ov%glob_to_loc(Size(desc_a%glob_to_loc)),stat=info) + if (info /= 0) then + info=4000 + call psb_errpush(info,name) + goto 9999 + end if desc_ov%loc_to_glob(:) = desc_a%loc_to_glob(:) desc_ov%glob_to_loc(:) = desc_a%glob_to_loc(:) @@ -213,7 +218,7 @@ Subroutine psb_dcdovr(a,desc_a,novr,desc_ov,info) ! Call psb_cdovrbld(novr,desc_ov,desc_a,a,& & l_tmp_halo,l_tmp_ovr_idx,lworks,lworkr,info) - if (info.ne.0) then + if (info /= 0) then info=4010 ch_err='psb_cdovrbld' call psb_errpush(info,name,a_err=ch_err) @@ -231,7 +236,7 @@ Subroutine psb_dcdovr(a,desc_a,novr,desc_ov,info) 9999 continue call psb_erractionrestore(err_act) - if (err_act.eq.act_abort) then + if (err_act == act_abort) then call psb_error(ictxt) return end if diff --git a/src/tools/psb_dcdovrbld.f90 b/src/tools/psb_dcdovrbld.f90 index 873dc475..abd61c45 100644 --- a/src/tools/psb_dcdovrbld.f90 +++ b/src/tools/psb_dcdovrbld.f90 @@ -87,7 +87,7 @@ Subroutine psb_dcdovrbld(n_ovr,desc_p,desc_a,a,& real(kind(1.d0)) :: t1,t2,t3,t4,t5,t6,t7, tl, tch character(len=20) :: name, ch_err - if(psb_get_errstatus().ne.0) return + if(psb_get_errstatus() /= 0) return info=0 name='psb_cdovrbld' call psb_erractionsave(err_act) @@ -99,6 +99,10 @@ Subroutine psb_dcdovrbld(n_ovr,desc_p,desc_a,a,& call psb_nullify_sp(blk) Allocate(brvindx(np+1),rvsz(np),sdsz(np),bsdindx(np+1),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if tl = 0.0 tch = 0.0 t4 = 0.0 @@ -122,7 +126,7 @@ Subroutine psb_dcdovrbld(n_ovr,desc_p,desc_a,a,& call psb_sp_all(blk,max(lworks,lworkr),info) - if (info.ne.0) then + if (info /= 0) then info=4010 ch_err='psb_sp_all' call psb_errpush(info,name,a_err=ch_err) @@ -148,7 +152,7 @@ Subroutine psb_dcdovrbld(n_ovr,desc_p,desc_a,a,& ! See comment in main loop below. call InitPairSearchTree(info) - if (info.ne.0) then + if (info /= 0) then info=4010 ch_err='InitPairSearhTree' call psb_errpush(info,name,a_err=ch_err) @@ -254,7 +258,7 @@ Subroutine psb_dcdovrbld(n_ovr,desc_p,desc_a,a,& isz = max((3*Size(tmp_ovr_idx))/2,(counter_o+3)) if (debug) write(0,*) myrow,'Realloc tmp_ovr',isz call psb_realloc(isz,tmp_ovr_idx,info,pad=-1) - if (info.ne.0) then + if (info /= 0) then info=4010 ch_err='psb_realloc' call psb_errpush(info,name,a_err=ch_err) @@ -272,7 +276,7 @@ Subroutine psb_dcdovrbld(n_ovr,desc_p,desc_a,a,& isz = max((3*Size(tmp_halo))/2,(counter_h+3)) if (debug) write(0,*) myrow,'Realloc tmp_halo',isz call psb_realloc(isz,tmp_halo,info) - if (info.ne.0) then + if (info /= 0) then info=4010 ch_err='psb_realloc' call psb_errpush(info,name,a_err=ch_err) @@ -298,7 +302,7 @@ Subroutine psb_dcdovrbld(n_ovr,desc_p,desc_a,a,& isz = max((3*Size(desc_p%ovrlap_elem))/2,(counter_e+3)) if (debug) write(0,*) myrow,'Realloc ovr_El',isz call psb_realloc(isz,desc_p%ovrlap_elem,info) - if (info.ne.0) then + if (info /= 0) then info=4010 ch_err='psrealloc' call psb_errpush(info,name,a_err=ch_err) @@ -331,7 +335,7 @@ Subroutine psb_dcdovrbld(n_ovr,desc_p,desc_a,a,& isz = max((3*Size(tmp_ovr_idx))/2,(counter_o+3)) if (debug) write(0,*) myrow,'Realloc tmp_ovr',isz call psb_realloc(isz,tmp_ovr_idx,info) - if (info.ne.0) then + if (info /= 0) then info=4010 ch_err='psrealloc' call psb_errpush(info,name,a_err=ch_err) @@ -356,7 +360,7 @@ Subroutine psb_dcdovrbld(n_ovr,desc_p,desc_a,a,& isz = max((3*Size(desc_p%ovrlap_elem))/2,(counter_e+3)) if (debug) write(0,*) myrow,'Realloc ovr_el',isz call psb_realloc(isz,desc_p%ovrlap_elem,info) - if (info.ne.0) then + if (info /= 0) then info=4010 ch_err='psb_realloc' call psb_errpush(info,name,a_err=ch_err) @@ -378,7 +382,7 @@ Subroutine psb_dcdovrbld(n_ovr,desc_p,desc_a,a,& ! If (i_ovr < (n_ovr)) Then call psb_spinfo(psb_nzrowreq_,a,n_elem,info,iaux=idx) - if (info.ne.0) then + if (info /= 0) then info=4010 ch_err='psb_spinfo' call psb_errpush(info,name,a_err=ch_err) @@ -389,7 +393,7 @@ Subroutine psb_dcdovrbld(n_ovr,desc_p,desc_a,a,& isz = max((3*lworks)/2,(idxs+tot_elem+n_elem)) if (debug) write(0,*) myrow,'Realloc works',isz call psb_realloc(isz,works,info) - if (info.ne.0) then + if (info /= 0) then info=4010 ch_err='psb_realloc' call psb_errpush(info,name,a_err=ch_err) @@ -401,7 +405,7 @@ Subroutine psb_dcdovrbld(n_ovr,desc_p,desc_a,a,& isz = max((3*size(blk%ia2))/2,(n_elem)) if (debug) write(0,*) myrow,'Realloc blk',isz call psb_sp_reall(blk,isz,info) - if (info.ne.0) then + if (info /= 0) then info=4010 ch_err='psb_sp_reall' call psb_errpush(info,name,a_err=ch_err) @@ -410,7 +414,7 @@ Subroutine psb_dcdovrbld(n_ovr,desc_p,desc_a,a,& End If call psb_spgtblk(idx,a,blk,info) - if (info.ne.0) then + if (info /= 0) then info=4010 ch_err='psb_spgtblk' call psb_errpush(info,name,a_err=ch_err) @@ -434,6 +438,10 @@ Subroutine psb_dcdovrbld(n_ovr,desc_p,desc_a,a,& !!$ write(0,*) me,'Realloc temp',tot_elem+2 deallocate(temp) allocate(temp(tot_elem+2),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if endif Call mrgsrt(tot_elem,works(idxs+1),temp,info) If (info.Eq.0) Call ireordv1(tot_elem,works(idxs+1),temp) @@ -467,7 +475,7 @@ Subroutine psb_dcdovrbld(n_ovr,desc_p,desc_a,a,& ! matchings SENDs. ! call mpi_alltoall(sdsz,1,mpi_integer,rvsz,1,mpi_integer,icomm,info) - if (info.ne.0) then + if (info /= 0) then info=4010 ch_err='mpi_alltoall' call psb_errpush(info,name,a_err=ch_err) @@ -493,7 +501,7 @@ Subroutine psb_dcdovrbld(n_ovr,desc_p,desc_a,a,& iszr=sum(rvsz) if (max(iszr,1) > lworkr) then call psb_realloc(max(iszr,1),workr,info) - if (info.ne.0) then + if (info /= 0) then info=4010 ch_err='psb_realloc' call psb_errpush(info,name,a_err=ch_err) @@ -504,7 +512,7 @@ Subroutine psb_dcdovrbld(n_ovr,desc_p,desc_a,a,& call mpi_alltoallv(works,sdsz,bsdindx,mpi_integer,& & workr,rvsz,brvindx,mpi_integer,icomm,info) - if (info.ne.0) then + if (info /= 0) then info=4010 ch_err='mpi_alltoallv' call psb_errpush(info,name,a_err=ch_err) @@ -528,7 +536,7 @@ Subroutine psb_dcdovrbld(n_ovr,desc_p,desc_a,a,& isz = 3*n_col/2 if (debug) write(0,*) myrow,'Realloc loc_to_glob' call psb_realloc(isz,desc_p%loc_to_glob,info) - if (info.ne.0) then + if (info /= 0) then info=4010 ch_err='psrealloc' call psb_errpush(info,name,a_err=ch_err) @@ -570,6 +578,11 @@ Subroutine psb_dcdovrbld(n_ovr,desc_p,desc_a,a,& if (debug) write(0,*) myrow,'Realloc work',isz deallocate(work) allocate(work(isz),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + lwork=size(work) Endif t_halo_in(counter_t)=-1 @@ -626,7 +639,7 @@ Subroutine psb_dcdovrbld(n_ovr,desc_p,desc_a,a,& ! first the halo index call psi_crea_index(desc_p,tmp_halo,& & desc_p%halo_index,.false.,info) - if(info.ne.0) then + if(info /= 0) then call psb_errpush(4010,name,a_err='psi_crea_index') goto 9999 end if @@ -634,7 +647,7 @@ Subroutine psb_dcdovrbld(n_ovr,desc_p,desc_a,a,& ! then the overlap index call psi_crea_index(desc_p,tmp_ovr_idx,& & desc_p%ovrlap_index,.true.,info) - if(info.ne.0) then + if(info /= 0) then call psb_errpush(4010,name,a_err='psi_crea_index') goto 9999 end if @@ -644,7 +657,7 @@ Subroutine psb_dcdovrbld(n_ovr,desc_p,desc_a,a,& ! finally bnd_elem call psi_crea_bnd_elem(desc_p,info) - if(info.ne.0) then + if(info /= 0) then call psb_errpush(4010,name,a_err='psi_crea_bnd_elem') goto 9999 end if @@ -652,7 +665,12 @@ Subroutine psb_dcdovrbld(n_ovr,desc_p,desc_a,a,& ! Ok, register into MATRIX_DATA & free temporary work areas desc_p%matrix_data(psb_dec_type_) = psb_desc_asb_ - allocate(desc_p%lprm(1)) + allocate(desc_p%lprm(1),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + desc_p%lprm(1) = 0 if (debug) then @@ -669,8 +687,8 @@ Subroutine psb_dcdovrbld(n_ovr,desc_p,desc_a,a,& Deallocate(works,workr,t_halo_in,t_halo_out,work,& & length_dl,dep_list,tmp_ovr_idx,tmp_halo,& & brvindx,rvsz,sdsz,bsdindx,temp,stat=info) - call psb_sp_free(blk,info) - if (info.ne.0) then + if (info == 0) call psb_sp_free(blk,info) + if (info /= 0) then info=4010 ch_err='sp_free' call psb_errpush(info,name,a_err=ch_err) diff --git a/src/tools/psb_zcdovr.f90 b/src/tools/psb_zcdovr.f90 index cc4ff8aa..7943c5a6 100644 --- a/src/tools/psb_zcdovr.f90 +++ b/src/tools/psb_zcdovr.f90 @@ -126,7 +126,7 @@ Subroutine psb_zcdovr(a,desc_a,novr,desc_ov,info) ! if (debug) write(0,*) 'Calling desccpy' call psb_cdcpy(desc_a,desc_ov,info) - if (info.ne.0) then + if (info /= 0) then info=4010 ch_err='psb_cdcpy' call psb_errpush(info,name,a_err=ch_err) @@ -161,7 +161,7 @@ Subroutine psb_zcdovr(a,desc_a,novr,desc_ov,info) ! nonzeros per row is the same as the global. ! call psb_spinfo(psb_nztotreq_,a,nztot,info) - if (info.ne.0) then + if (info /= 0) then info=4010 ch_err='psb_spinfo' call psb_errpush(info,name,a_err=ch_err) @@ -184,7 +184,7 @@ Subroutine psb_zcdovr(a,desc_a,novr,desc_ov,info) & desc_ov%ovrlap_elem(novr*(Max(elem_dim,1)+3)),& & desc_ov%matrix_data(psb_mdata_size_),& & desc_ov%halo_index(novr*(Size(desc_a%halo_index)+3)),STAT=INFO) - if (info.ne.0) then + if (info /= 0) then info=4000 call psb_errpush(info,name) goto 9999 @@ -200,7 +200,12 @@ Subroutine psb_zcdovr(a,desc_a,novr,desc_ov,info) desc_ov%matrix_data(psb_dec_type_) = psb_desc_bld_ Allocate(desc_ov%loc_to_glob(Size(desc_a%loc_to_glob)),& - & desc_ov%glob_to_loc(Size(desc_a%glob_to_loc))) + & desc_ov%glob_to_loc(Size(desc_a%glob_to_loc)),stat=info) + if (info /= 0) then + info=4000 + call psb_errpush(info,name) + goto 9999 + end if desc_ov%loc_to_glob(:) = desc_a%loc_to_glob(:) desc_ov%glob_to_loc(:) = desc_a%glob_to_loc(:) @@ -214,7 +219,7 @@ Subroutine psb_zcdovr(a,desc_a,novr,desc_ov,info) ! Call psb_cdovrbld(novr,desc_ov,desc_a,a,& & l_tmp_halo,l_tmp_ovr_idx,lworks,lworkr,info) - if (info.ne.0) then + if (info /= 0) then info=4010 ch_err='psb_cdovrbld' call psb_errpush(info,name,a_err=ch_err) @@ -232,7 +237,7 @@ Subroutine psb_zcdovr(a,desc_a,novr,desc_ov,info) 9999 continue call psb_erractionrestore(err_act) - if (err_act.eq.act_abort) then + if (err_act == act_abort) then call psb_error(ictxt) return end if diff --git a/src/tools/psb_zcdovrbld.f90 b/src/tools/psb_zcdovrbld.f90 index 235074b8..7c9a7b8d 100644 --- a/src/tools/psb_zcdovrbld.f90 +++ b/src/tools/psb_zcdovrbld.f90 @@ -87,7 +87,7 @@ Subroutine psb_zcdovrbld(n_ovr,desc_p,desc_a,a,& real(kind(1.d0)) :: t1,t2,t3,t4,t5,t6,t7, tl, tch character(len=20) :: name, ch_err - if(psb_get_errstatus().ne.0) return + if(psb_get_errstatus() /= 0) return info=0 name='psb_cdovrbld' call psb_erractionsave(err_act) @@ -99,6 +99,10 @@ Subroutine psb_zcdovrbld(n_ovr,desc_p,desc_a,a,& call psb_nullify_sp(blk) Allocate(brvindx(np+1),rvsz(np),sdsz(np),bsdindx(np+1),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if tl = 0.0 tch = 0.0 t4 = 0.0 @@ -122,7 +126,7 @@ Subroutine psb_zcdovrbld(n_ovr,desc_p,desc_a,a,& call psb_sp_all(blk,max(lworks,lworkr),info) - if (info.ne.0) then + if (info /= 0) then info=4010 ch_err='psb_sp_all' call psb_errpush(info,name,a_err=ch_err) @@ -148,7 +152,7 @@ Subroutine psb_zcdovrbld(n_ovr,desc_p,desc_a,a,& ! See comment in main loop below. call InitPairSearchTree(info) - if (info.ne.0) then + if (info /= 0) then info=4010 ch_err='InitPairSearhTree' call psb_errpush(info,name,a_err=ch_err) @@ -254,7 +258,7 @@ Subroutine psb_zcdovrbld(n_ovr,desc_p,desc_a,a,& isz = max((3*Size(tmp_ovr_idx))/2,(counter_o+3)) if (debug) write(0,*) myrow,'Realloc tmp_ovr',isz call psb_realloc(isz,tmp_ovr_idx,info,pad=-1) - if (info.ne.0) then + if (info /= 0) then info=4010 ch_err='psb_realloc' call psb_errpush(info,name,a_err=ch_err) @@ -272,7 +276,7 @@ Subroutine psb_zcdovrbld(n_ovr,desc_p,desc_a,a,& isz = max((3*Size(tmp_halo))/2,(counter_h+3)) if (debug) write(0,*) myrow,'Realloc tmp_halo',isz call psb_realloc(isz,tmp_halo,info) - if (info.ne.0) then + if (info /= 0) then info=4010 ch_err='psb_realloc' call psb_errpush(info,name,a_err=ch_err) @@ -298,7 +302,7 @@ Subroutine psb_zcdovrbld(n_ovr,desc_p,desc_a,a,& isz = max((3*Size(desc_p%ovrlap_elem))/2,(counter_e+3)) if (debug) write(0,*) myrow,'Realloc ovr_El',isz call psb_realloc(isz,desc_p%ovrlap_elem,info) - if (info.ne.0) then + if (info /= 0) then info=4010 ch_err='psrealloc' call psb_errpush(info,name,a_err=ch_err) @@ -331,7 +335,7 @@ Subroutine psb_zcdovrbld(n_ovr,desc_p,desc_a,a,& isz = max((3*Size(tmp_ovr_idx))/2,(counter_o+3)) if (debug) write(0,*) myrow,'Realloc tmp_ovr',isz call psb_realloc(isz,tmp_ovr_idx,info) - if (info.ne.0) then + if (info /= 0) then info=4010 ch_err='psrealloc' call psb_errpush(info,name,a_err=ch_err) @@ -356,7 +360,7 @@ Subroutine psb_zcdovrbld(n_ovr,desc_p,desc_a,a,& isz = max((3*Size(desc_p%ovrlap_elem))/2,(counter_e+3)) if (debug) write(0,*) myrow,'Realloc ovr_el',isz call psb_realloc(isz,desc_p%ovrlap_elem,info) - if (info.ne.0) then + if (info /= 0) then info=4010 ch_err='psb_realloc' call psb_errpush(info,name,a_err=ch_err) @@ -378,7 +382,7 @@ Subroutine psb_zcdovrbld(n_ovr,desc_p,desc_a,a,& ! If (i_ovr < (n_ovr)) Then call psb_spinfo(psb_nzrowreq_,a,n_elem,info,iaux=idx) - if (info.ne.0) then + if (info /= 0) then info=4010 ch_err='psb_spinfo' call psb_errpush(info,name,a_err=ch_err) @@ -389,7 +393,7 @@ Subroutine psb_zcdovrbld(n_ovr,desc_p,desc_a,a,& isz = max((3*lworks)/2,(idxs+tot_elem+n_elem)) if (debug) write(0,*) myrow,'Realloc works',isz call psb_realloc(isz,works,info) - if (info.ne.0) then + if (info /= 0) then info=4010 ch_err='psb_realloc' call psb_errpush(info,name,a_err=ch_err) @@ -401,7 +405,7 @@ Subroutine psb_zcdovrbld(n_ovr,desc_p,desc_a,a,& isz = max((3*size(blk%ia2))/2,(n_elem)) if (debug) write(0,*) myrow,'Realloc blk',isz call psb_sp_reall(blk,isz,info) - if (info.ne.0) then + if (info /= 0) then info=4010 ch_err='psb_sp_reall' call psb_errpush(info,name,a_err=ch_err) @@ -410,7 +414,7 @@ Subroutine psb_zcdovrbld(n_ovr,desc_p,desc_a,a,& End If call psb_spgtblk(idx,a,blk,info) - if (info.ne.0) then + if (info /= 0) then info=4010 ch_err='psb_spgtblk' call psb_errpush(info,name,a_err=ch_err) @@ -434,6 +438,10 @@ Subroutine psb_zcdovrbld(n_ovr,desc_p,desc_a,a,& !!$ write(0,*) me,'Realloc temp',tot_elem+2 deallocate(temp) allocate(temp(tot_elem+2),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if endif Call mrgsrt(tot_elem,works(idxs+1),temp,info) If (info.Eq.0) Call ireordv1(tot_elem,works(idxs+1),temp) @@ -467,7 +475,7 @@ Subroutine psb_zcdovrbld(n_ovr,desc_p,desc_a,a,& ! matchings SENDs. ! call mpi_alltoall(sdsz,1,mpi_integer,rvsz,1,mpi_integer,icomm,info) - if (info.ne.0) then + if (info /= 0) then info=4010 ch_err='mpi_alltoall' call psb_errpush(info,name,a_err=ch_err) @@ -493,7 +501,7 @@ Subroutine psb_zcdovrbld(n_ovr,desc_p,desc_a,a,& iszr=sum(rvsz) if (max(iszr,1) > lworkr) then call psb_realloc(max(iszr,1),workr,info) - if (info.ne.0) then + if (info /= 0) then info=4010 ch_err='psb_realloc' call psb_errpush(info,name,a_err=ch_err) @@ -504,7 +512,7 @@ Subroutine psb_zcdovrbld(n_ovr,desc_p,desc_a,a,& call mpi_alltoallv(works,sdsz,bsdindx,mpi_integer,& & workr,rvsz,brvindx,mpi_integer,icomm,info) - if (info.ne.0) then + if (info /= 0) then info=4010 ch_err='mpi_alltoallv' call psb_errpush(info,name,a_err=ch_err) @@ -528,7 +536,7 @@ Subroutine psb_zcdovrbld(n_ovr,desc_p,desc_a,a,& isz = 3*n_col/2 if (debug) write(0,*) myrow,'Realloc loc_to_glob' call psb_realloc(isz,desc_p%loc_to_glob,info) - if (info.ne.0) then + if (info /= 0) then info=4010 ch_err='psrealloc' call psb_errpush(info,name,a_err=ch_err) @@ -570,6 +578,11 @@ Subroutine psb_zcdovrbld(n_ovr,desc_p,desc_a,a,& if (debug) write(0,*) myrow,'Realloc work',isz deallocate(work) allocate(work(isz),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + lwork=size(work) Endif t_halo_in(counter_t)=-1 @@ -626,7 +639,7 @@ Subroutine psb_zcdovrbld(n_ovr,desc_p,desc_a,a,& ! first the halo index call psi_crea_index(desc_p,tmp_halo,& & desc_p%halo_index,.false.,info) - if(info.ne.0) then + if(info /= 0) then call psb_errpush(4010,name,a_err='psi_crea_index') goto 9999 end if @@ -634,7 +647,7 @@ Subroutine psb_zcdovrbld(n_ovr,desc_p,desc_a,a,& ! then the overlap index call psi_crea_index(desc_p,tmp_ovr_idx,& & desc_p%ovrlap_index,.true.,info) - if(info.ne.0) then + if(info /= 0) then call psb_errpush(4010,name,a_err='psi_crea_index') goto 9999 end if @@ -644,7 +657,7 @@ Subroutine psb_zcdovrbld(n_ovr,desc_p,desc_a,a,& ! finally bnd_elem call psi_crea_bnd_elem(desc_p,info) - if(info.ne.0) then + if(info /= 0) then call psb_errpush(4010,name,a_err='psi_crea_bnd_elem') goto 9999 end if @@ -652,7 +665,12 @@ Subroutine psb_zcdovrbld(n_ovr,desc_p,desc_a,a,& ! Ok, register into MATRIX_DATA & free temporary work areas desc_p%matrix_data(psb_dec_type_) = psb_desc_asb_ - allocate(desc_p%lprm(1)) + allocate(desc_p%lprm(1),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + desc_p%lprm(1) = 0 if (debug) then @@ -669,8 +687,8 @@ Subroutine psb_zcdovrbld(n_ovr,desc_p,desc_a,a,& Deallocate(works,workr,t_halo_in,t_halo_out,work,& & length_dl,dep_list,tmp_ovr_idx,tmp_halo,& & brvindx,rvsz,sdsz,bsdindx,temp,stat=info) - call psb_sp_free(blk,info) - if (info.ne.0) then + if (info == 0) call psb_sp_free(blk,info) + if (info /= 0) then info=4010 ch_err='sp_free' call psb_errpush(info,name,a_err=ch_err) diff --git a/test/Fileread/df_sample.f90 b/test/Fileread/df_sample.f90 index 5ab45b06..44da03c3 100644 --- a/test/Fileread/df_sample.f90 +++ b/test/Fileread/df_sample.f90 @@ -276,7 +276,7 @@ program df_sample call blacs_barrier(ictxt,'all') t1 = mpi_wtime() call psb_krylov(cmethd,a,pre,b_col,x_col,eps,desc_a,info,& - & itmax,iter,err,itrace,istop=istopc,irst=ml) + & itmax=itmax,iter=iter,err=err,itrace=itrace,istop=istopc,irst=ml) call blacs_barrier(ictxt,'all') t2 = mpi_wtime() - t1 call psb_amx(ictxt,t2) diff --git a/test/Fileread/zf_sample.f90 b/test/Fileread/zf_sample.f90 index 6f9e7747..a20b93fc 100644 --- a/test/Fileread/zf_sample.f90 +++ b/test/Fileread/zf_sample.f90 @@ -273,7 +273,7 @@ program zf_sample call blacs_barrier(ictxt,'all') t1 = mpi_wtime() call psb_krylov(cmethd,a,pre,b_col,x_col,eps,desc_a,info,& - & itmax,iter,err,itrace,istop=istopc,irst=ml) + & itmax=itmax,iter=iter,err=err,itrace=itrace,istop=istopc,irst=ml) call blacs_barrier(ictxt,'all') t2 = mpi_wtime() - t1 call psb_amx(ictxt,t2) diff --git a/test/pargen/ppde90.f90 b/test/pargen/ppde90.f90 index 6093230a..67a4b65b 100644 --- a/test/pargen/ppde90.f90 +++ b/test/pargen/ppde90.f90 @@ -202,7 +202,7 @@ program pde90 t1 = mpi_wtime() eps = 1.d-9 call psb_krylov(cmethd,a,pre,b,x,eps,desc_a,info,& - & itmax,iter,err,itrace,istop=istopc,irst=ml) + & itmax=itmax,iter=iter,err=err,itrace=itrace,istop=istopc,irst=ml) if(info.ne.0) then info=4010