Make base_solver_free a noop, check for error in level_setsv.

stopcriterion
Salvatore Filippone 7 years ago
parent 6632e01e97
commit 3fd565bc99

@ -72,7 +72,7 @@ subroutine mld_c_base_onelev_setsv(lev,val,info,pos)
if (allocated(lev%sm%sv)) then
if (.not.same_type_as(lev%sm%sv,val)) then
call lev%sm%sv%free(info)
deallocate(lev%sm%sv,stat=info)
if (info == 0) deallocate(lev%sm%sv,stat=info)
if (info /= 0) then
info = 3111
return
@ -117,7 +117,7 @@ subroutine mld_c_base_onelev_setsv(lev,val,info,pos)
if (allocated(lev%sm2a%sv)) then
if (.not.same_type_as(lev%sm2a%sv,val)) then
call lev%sm2a%sv%free(info)
deallocate(lev%sm2a%sv,stat=info)
if (info == 0) deallocate(lev%sm2a%sv,stat=info)
if (info /= 0) then
info = 3111
return

@ -72,7 +72,7 @@ subroutine mld_d_base_onelev_setsv(lev,val,info,pos)
if (allocated(lev%sm%sv)) then
if (.not.same_type_as(lev%sm%sv,val)) then
call lev%sm%sv%free(info)
deallocate(lev%sm%sv,stat=info)
if (info == 0) deallocate(lev%sm%sv,stat=info)
if (info /= 0) then
info = 3111
return
@ -117,7 +117,7 @@ subroutine mld_d_base_onelev_setsv(lev,val,info,pos)
if (allocated(lev%sm2a%sv)) then
if (.not.same_type_as(lev%sm2a%sv,val)) then
call lev%sm2a%sv%free(info)
deallocate(lev%sm2a%sv,stat=info)
if (info == 0) deallocate(lev%sm2a%sv,stat=info)
if (info /= 0) then
info = 3111
return

@ -72,7 +72,7 @@ subroutine mld_s_base_onelev_setsv(lev,val,info,pos)
if (allocated(lev%sm%sv)) then
if (.not.same_type_as(lev%sm%sv,val)) then
call lev%sm%sv%free(info)
deallocate(lev%sm%sv,stat=info)
if (info == 0) deallocate(lev%sm%sv,stat=info)
if (info /= 0) then
info = 3111
return
@ -117,7 +117,7 @@ subroutine mld_s_base_onelev_setsv(lev,val,info,pos)
if (allocated(lev%sm2a%sv)) then
if (.not.same_type_as(lev%sm2a%sv,val)) then
call lev%sm2a%sv%free(info)
deallocate(lev%sm2a%sv,stat=info)
if (info == 0) deallocate(lev%sm2a%sv,stat=info)
if (info /= 0) then
info = 3111
return

@ -72,7 +72,7 @@ subroutine mld_z_base_onelev_setsv(lev,val,info,pos)
if (allocated(lev%sm%sv)) then
if (.not.same_type_as(lev%sm%sv,val)) then
call lev%sm%sv%free(info)
deallocate(lev%sm%sv,stat=info)
if (info == 0) deallocate(lev%sm%sv,stat=info)
if (info /= 0) then
info = 3111
return
@ -117,7 +117,7 @@ subroutine mld_z_base_onelev_setsv(lev,val,info,pos)
if (allocated(lev%sm2a%sv)) then
if (.not.same_type_as(lev%sm2a%sv,val)) then
call lev%sm2a%sv%free(info)
deallocate(lev%sm2a%sv,stat=info)
if (info == 0) deallocate(lev%sm2a%sv,stat=info)
if (info /= 0) then
info = 3111
return

@ -48,9 +48,8 @@ subroutine mld_c_base_solver_free(sv,info)
call psb_erractionsave(err_act)
info = psb_err_missing_override_method_
call psb_errpush(info,name)
goto 9999
! Do nothing
info = psb_success_
call psb_erractionrestore(err_act)
return

@ -48,9 +48,8 @@ subroutine mld_d_base_solver_free(sv,info)
call psb_erractionsave(err_act)
info = psb_err_missing_override_method_
call psb_errpush(info,name)
goto 9999
! Do nothing
info = psb_success_
call psb_erractionrestore(err_act)
return

@ -48,9 +48,8 @@ subroutine mld_s_base_solver_free(sv,info)
call psb_erractionsave(err_act)
info = psb_err_missing_override_method_
call psb_errpush(info,name)
goto 9999
! Do nothing
info = psb_success_
call psb_erractionrestore(err_act)
return

@ -48,9 +48,8 @@ subroutine mld_z_base_solver_free(sv,info)
call psb_erractionsave(err_act)
info = psb_err_missing_override_method_
call psb_errpush(info,name)
goto 9999
! Do nothing
info = psb_success_
call psb_erractionrestore(err_act)
return

Loading…
Cancel
Save