mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-07 15:14:57 +00:00
Fix SYM handling at spmat level.
This commit is contained in:
Salvatore Filippone
@@ -104,6 +104,7 @@ module psb_c_mat_mod
|
||||
procedure, pass(a) :: is_upper => psb_c_is_upper
|
||||
procedure, pass(a) :: is_lower => psb_c_is_lower
|
||||
procedure, pass(a) :: is_triangle => psb_c_is_triangle
|
||||
procedure, pass(a) :: is_symmetric => psb_c_is_symmetric
|
||||
procedure, pass(a) :: is_unit => psb_c_is_unit
|
||||
procedure, pass(a) :: is_repeatable_updates => psb_c_is_repeatable_updates
|
||||
procedure, pass(a) :: get_fmt => psb_c_get_fmt
|
||||
@@ -121,6 +122,7 @@ module psb_c_mat_mod
|
||||
procedure, pass(a) :: set_upper => psb_c_set_upper
|
||||
procedure, pass(a) :: set_lower => psb_c_set_lower
|
||||
procedure, pass(a) :: set_triangle => psb_c_set_triangle
|
||||
procedure, pass(a) :: set_symmetric => psb_c_set_symmetric
|
||||
procedure, pass(a) :: set_unit => psb_c_set_unit
|
||||
procedure, pass(a) :: set_repeatable_updates => psb_c_set_repeatable_updates
|
||||
|
||||
@@ -284,6 +286,7 @@ module psb_c_mat_mod
|
||||
procedure, pass(a) :: is_upper => psb_lc_is_upper
|
||||
procedure, pass(a) :: is_lower => psb_lc_is_lower
|
||||
procedure, pass(a) :: is_triangle => psb_lc_is_triangle
|
||||
procedure, pass(a) :: is_symmetric => psb_lc_is_symmetric
|
||||
procedure, pass(a) :: is_unit => psb_lc_is_unit
|
||||
procedure, pass(a) :: is_repeatable_updates => psb_lc_is_repeatable_updates
|
||||
procedure, pass(a) :: get_fmt => psb_lc_get_fmt
|
||||
@@ -301,6 +304,7 @@ module psb_c_mat_mod
|
||||
procedure, pass(a) :: set_upper => psb_lc_set_upper
|
||||
procedure, pass(a) :: set_lower => psb_lc_set_lower
|
||||
procedure, pass(a) :: set_triangle => psb_lc_set_triangle
|
||||
procedure, pass(a) :: set_symmetric => psb_lc_set_symmetric
|
||||
procedure, pass(a) :: set_unit => psb_lc_set_unit
|
||||
procedure, pass(a) :: set_repeatable_updates => psb_lc_set_repeatable_updates
|
||||
|
||||
@@ -509,6 +513,14 @@ module psb_c_mat_mod
|
||||
end subroutine psb_c_set_triangle
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_c_set_symmetric(a,val)
|
||||
import :: psb_ipk_, psb_cspmat_type
|
||||
class(psb_cspmat_type), intent(inout) :: a
|
||||
logical, intent(in), optional :: val
|
||||
end subroutine psb_c_set_symmetric
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_c_set_unit(a,val)
|
||||
import :: psb_ipk_, psb_lpk_, psb_cspmat_type
|
||||
@@ -1215,6 +1227,14 @@ module psb_c_mat_mod
|
||||
end subroutine psb_lc_set_triangle
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_lc_set_symmetric(a,val)
|
||||
import :: psb_ipk_, psb_lcspmat_type
|
||||
class(psb_lcspmat_type), intent(inout) :: a
|
||||
logical, intent(in), optional :: val
|
||||
end subroutine psb_lc_set_symmetric
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_lc_set_unit(a,val)
|
||||
import :: psb_ipk_, psb_lpk_, psb_lcspmat_type
|
||||
@@ -1873,6 +1893,19 @@ contains
|
||||
|
||||
end function psb_c_is_triangle
|
||||
|
||||
function psb_c_is_symmetric(a) result(res)
|
||||
implicit none
|
||||
class(psb_cspmat_type), intent(in) :: a
|
||||
logical :: res
|
||||
|
||||
if (allocated(a%a)) then
|
||||
res = a%a%is_symmetric()
|
||||
else
|
||||
res = .false.
|
||||
end if
|
||||
|
||||
end function psb_c_is_symmetric
|
||||
|
||||
function psb_c_is_unit(a) result(res)
|
||||
implicit none
|
||||
class(psb_cspmat_type), intent(in) :: a
|
||||
@@ -2370,6 +2403,20 @@ contains
|
||||
|
||||
end function psb_lc_is_triangle
|
||||
|
||||
|
||||
function psb_lc_is_symmetric(a) result(res)
|
||||
implicit none
|
||||
class(psb_lcspmat_type), intent(in) :: a
|
||||
logical :: res
|
||||
|
||||
if (allocated(a%a)) then
|
||||
res = a%a%is_symmetric()
|
||||
else
|
||||
res = .false.
|
||||
end if
|
||||
|
||||
end function psb_lc_is_symmetric
|
||||
|
||||
function psb_lc_is_unit(a) result(res)
|
||||
implicit none
|
||||
class(psb_lcspmat_type), intent(in) :: a
|
||||
|
||||
@@ -104,6 +104,7 @@ module psb_d_mat_mod
|
||||
procedure, pass(a) :: is_upper => psb_d_is_upper
|
||||
procedure, pass(a) :: is_lower => psb_d_is_lower
|
||||
procedure, pass(a) :: is_triangle => psb_d_is_triangle
|
||||
procedure, pass(a) :: is_symmetric => psb_d_is_symmetric
|
||||
procedure, pass(a) :: is_unit => psb_d_is_unit
|
||||
procedure, pass(a) :: is_repeatable_updates => psb_d_is_repeatable_updates
|
||||
procedure, pass(a) :: get_fmt => psb_d_get_fmt
|
||||
@@ -121,6 +122,7 @@ module psb_d_mat_mod
|
||||
procedure, pass(a) :: set_upper => psb_d_set_upper
|
||||
procedure, pass(a) :: set_lower => psb_d_set_lower
|
||||
procedure, pass(a) :: set_triangle => psb_d_set_triangle
|
||||
procedure, pass(a) :: set_symmetric => psb_d_set_symmetric
|
||||
procedure, pass(a) :: set_unit => psb_d_set_unit
|
||||
procedure, pass(a) :: set_repeatable_updates => psb_d_set_repeatable_updates
|
||||
|
||||
@@ -284,6 +286,7 @@ module psb_d_mat_mod
|
||||
procedure, pass(a) :: is_upper => psb_ld_is_upper
|
||||
procedure, pass(a) :: is_lower => psb_ld_is_lower
|
||||
procedure, pass(a) :: is_triangle => psb_ld_is_triangle
|
||||
procedure, pass(a) :: is_symmetric => psb_ld_is_symmetric
|
||||
procedure, pass(a) :: is_unit => psb_ld_is_unit
|
||||
procedure, pass(a) :: is_repeatable_updates => psb_ld_is_repeatable_updates
|
||||
procedure, pass(a) :: get_fmt => psb_ld_get_fmt
|
||||
@@ -301,6 +304,7 @@ module psb_d_mat_mod
|
||||
procedure, pass(a) :: set_upper => psb_ld_set_upper
|
||||
procedure, pass(a) :: set_lower => psb_ld_set_lower
|
||||
procedure, pass(a) :: set_triangle => psb_ld_set_triangle
|
||||
procedure, pass(a) :: set_symmetric => psb_ld_set_symmetric
|
||||
procedure, pass(a) :: set_unit => psb_ld_set_unit
|
||||
procedure, pass(a) :: set_repeatable_updates => psb_ld_set_repeatable_updates
|
||||
|
||||
@@ -509,6 +513,14 @@ module psb_d_mat_mod
|
||||
end subroutine psb_d_set_triangle
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_d_set_symmetric(a,val)
|
||||
import :: psb_ipk_, psb_dspmat_type
|
||||
class(psb_dspmat_type), intent(inout) :: a
|
||||
logical, intent(in), optional :: val
|
||||
end subroutine psb_d_set_symmetric
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_d_set_unit(a,val)
|
||||
import :: psb_ipk_, psb_lpk_, psb_dspmat_type
|
||||
@@ -1215,6 +1227,14 @@ module psb_d_mat_mod
|
||||
end subroutine psb_ld_set_triangle
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_ld_set_symmetric(a,val)
|
||||
import :: psb_ipk_, psb_ldspmat_type
|
||||
class(psb_ldspmat_type), intent(inout) :: a
|
||||
logical, intent(in), optional :: val
|
||||
end subroutine psb_ld_set_symmetric
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_ld_set_unit(a,val)
|
||||
import :: psb_ipk_, psb_lpk_, psb_ldspmat_type
|
||||
@@ -1873,6 +1893,19 @@ contains
|
||||
|
||||
end function psb_d_is_triangle
|
||||
|
||||
function psb_d_is_symmetric(a) result(res)
|
||||
implicit none
|
||||
class(psb_dspmat_type), intent(in) :: a
|
||||
logical :: res
|
||||
|
||||
if (allocated(a%a)) then
|
||||
res = a%a%is_symmetric()
|
||||
else
|
||||
res = .false.
|
||||
end if
|
||||
|
||||
end function psb_d_is_symmetric
|
||||
|
||||
function psb_d_is_unit(a) result(res)
|
||||
implicit none
|
||||
class(psb_dspmat_type), intent(in) :: a
|
||||
@@ -2370,6 +2403,20 @@ contains
|
||||
|
||||
end function psb_ld_is_triangle
|
||||
|
||||
|
||||
function psb_ld_is_symmetric(a) result(res)
|
||||
implicit none
|
||||
class(psb_ldspmat_type), intent(in) :: a
|
||||
logical :: res
|
||||
|
||||
if (allocated(a%a)) then
|
||||
res = a%a%is_symmetric()
|
||||
else
|
||||
res = .false.
|
||||
end if
|
||||
|
||||
end function psb_ld_is_symmetric
|
||||
|
||||
function psb_ld_is_unit(a) result(res)
|
||||
implicit none
|
||||
class(psb_ldspmat_type), intent(in) :: a
|
||||
|
||||
@@ -104,6 +104,7 @@ module psb_s_mat_mod
|
||||
procedure, pass(a) :: is_upper => psb_s_is_upper
|
||||
procedure, pass(a) :: is_lower => psb_s_is_lower
|
||||
procedure, pass(a) :: is_triangle => psb_s_is_triangle
|
||||
procedure, pass(a) :: is_symmetric => psb_s_is_symmetric
|
||||
procedure, pass(a) :: is_unit => psb_s_is_unit
|
||||
procedure, pass(a) :: is_repeatable_updates => psb_s_is_repeatable_updates
|
||||
procedure, pass(a) :: get_fmt => psb_s_get_fmt
|
||||
@@ -121,6 +122,7 @@ module psb_s_mat_mod
|
||||
procedure, pass(a) :: set_upper => psb_s_set_upper
|
||||
procedure, pass(a) :: set_lower => psb_s_set_lower
|
||||
procedure, pass(a) :: set_triangle => psb_s_set_triangle
|
||||
procedure, pass(a) :: set_symmetric => psb_s_set_symmetric
|
||||
procedure, pass(a) :: set_unit => psb_s_set_unit
|
||||
procedure, pass(a) :: set_repeatable_updates => psb_s_set_repeatable_updates
|
||||
|
||||
@@ -284,6 +286,7 @@ module psb_s_mat_mod
|
||||
procedure, pass(a) :: is_upper => psb_ls_is_upper
|
||||
procedure, pass(a) :: is_lower => psb_ls_is_lower
|
||||
procedure, pass(a) :: is_triangle => psb_ls_is_triangle
|
||||
procedure, pass(a) :: is_symmetric => psb_ls_is_symmetric
|
||||
procedure, pass(a) :: is_unit => psb_ls_is_unit
|
||||
procedure, pass(a) :: is_repeatable_updates => psb_ls_is_repeatable_updates
|
||||
procedure, pass(a) :: get_fmt => psb_ls_get_fmt
|
||||
@@ -301,6 +304,7 @@ module psb_s_mat_mod
|
||||
procedure, pass(a) :: set_upper => psb_ls_set_upper
|
||||
procedure, pass(a) :: set_lower => psb_ls_set_lower
|
||||
procedure, pass(a) :: set_triangle => psb_ls_set_triangle
|
||||
procedure, pass(a) :: set_symmetric => psb_ls_set_symmetric
|
||||
procedure, pass(a) :: set_unit => psb_ls_set_unit
|
||||
procedure, pass(a) :: set_repeatable_updates => psb_ls_set_repeatable_updates
|
||||
|
||||
@@ -509,6 +513,14 @@ module psb_s_mat_mod
|
||||
end subroutine psb_s_set_triangle
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_s_set_symmetric(a,val)
|
||||
import :: psb_ipk_, psb_sspmat_type
|
||||
class(psb_sspmat_type), intent(inout) :: a
|
||||
logical, intent(in), optional :: val
|
||||
end subroutine psb_s_set_symmetric
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_s_set_unit(a,val)
|
||||
import :: psb_ipk_, psb_lpk_, psb_sspmat_type
|
||||
@@ -1215,6 +1227,14 @@ module psb_s_mat_mod
|
||||
end subroutine psb_ls_set_triangle
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_ls_set_symmetric(a,val)
|
||||
import :: psb_ipk_, psb_lsspmat_type
|
||||
class(psb_lsspmat_type), intent(inout) :: a
|
||||
logical, intent(in), optional :: val
|
||||
end subroutine psb_ls_set_symmetric
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_ls_set_unit(a,val)
|
||||
import :: psb_ipk_, psb_lpk_, psb_lsspmat_type
|
||||
@@ -1873,6 +1893,19 @@ contains
|
||||
|
||||
end function psb_s_is_triangle
|
||||
|
||||
function psb_s_is_symmetric(a) result(res)
|
||||
implicit none
|
||||
class(psb_sspmat_type), intent(in) :: a
|
||||
logical :: res
|
||||
|
||||
if (allocated(a%a)) then
|
||||
res = a%a%is_symmetric()
|
||||
else
|
||||
res = .false.
|
||||
end if
|
||||
|
||||
end function psb_s_is_symmetric
|
||||
|
||||
function psb_s_is_unit(a) result(res)
|
||||
implicit none
|
||||
class(psb_sspmat_type), intent(in) :: a
|
||||
@@ -2370,6 +2403,20 @@ contains
|
||||
|
||||
end function psb_ls_is_triangle
|
||||
|
||||
|
||||
function psb_ls_is_symmetric(a) result(res)
|
||||
implicit none
|
||||
class(psb_lsspmat_type), intent(in) :: a
|
||||
logical :: res
|
||||
|
||||
if (allocated(a%a)) then
|
||||
res = a%a%is_symmetric()
|
||||
else
|
||||
res = .false.
|
||||
end if
|
||||
|
||||
end function psb_ls_is_symmetric
|
||||
|
||||
function psb_ls_is_unit(a) result(res)
|
||||
implicit none
|
||||
class(psb_lsspmat_type), intent(in) :: a
|
||||
|
||||
@@ -104,6 +104,7 @@ module psb_z_mat_mod
|
||||
procedure, pass(a) :: is_upper => psb_z_is_upper
|
||||
procedure, pass(a) :: is_lower => psb_z_is_lower
|
||||
procedure, pass(a) :: is_triangle => psb_z_is_triangle
|
||||
procedure, pass(a) :: is_symmetric => psb_z_is_symmetric
|
||||
procedure, pass(a) :: is_unit => psb_z_is_unit
|
||||
procedure, pass(a) :: is_repeatable_updates => psb_z_is_repeatable_updates
|
||||
procedure, pass(a) :: get_fmt => psb_z_get_fmt
|
||||
@@ -121,6 +122,7 @@ module psb_z_mat_mod
|
||||
procedure, pass(a) :: set_upper => psb_z_set_upper
|
||||
procedure, pass(a) :: set_lower => psb_z_set_lower
|
||||
procedure, pass(a) :: set_triangle => psb_z_set_triangle
|
||||
procedure, pass(a) :: set_symmetric => psb_z_set_symmetric
|
||||
procedure, pass(a) :: set_unit => psb_z_set_unit
|
||||
procedure, pass(a) :: set_repeatable_updates => psb_z_set_repeatable_updates
|
||||
|
||||
@@ -284,6 +286,7 @@ module psb_z_mat_mod
|
||||
procedure, pass(a) :: is_upper => psb_lz_is_upper
|
||||
procedure, pass(a) :: is_lower => psb_lz_is_lower
|
||||
procedure, pass(a) :: is_triangle => psb_lz_is_triangle
|
||||
procedure, pass(a) :: is_symmetric => psb_lz_is_symmetric
|
||||
procedure, pass(a) :: is_unit => psb_lz_is_unit
|
||||
procedure, pass(a) :: is_repeatable_updates => psb_lz_is_repeatable_updates
|
||||
procedure, pass(a) :: get_fmt => psb_lz_get_fmt
|
||||
@@ -301,6 +304,7 @@ module psb_z_mat_mod
|
||||
procedure, pass(a) :: set_upper => psb_lz_set_upper
|
||||
procedure, pass(a) :: set_lower => psb_lz_set_lower
|
||||
procedure, pass(a) :: set_triangle => psb_lz_set_triangle
|
||||
procedure, pass(a) :: set_symmetric => psb_lz_set_symmetric
|
||||
procedure, pass(a) :: set_unit => psb_lz_set_unit
|
||||
procedure, pass(a) :: set_repeatable_updates => psb_lz_set_repeatable_updates
|
||||
|
||||
@@ -509,6 +513,14 @@ module psb_z_mat_mod
|
||||
end subroutine psb_z_set_triangle
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_z_set_symmetric(a,val)
|
||||
import :: psb_ipk_, psb_zspmat_type
|
||||
class(psb_zspmat_type), intent(inout) :: a
|
||||
logical, intent(in), optional :: val
|
||||
end subroutine psb_z_set_symmetric
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_z_set_unit(a,val)
|
||||
import :: psb_ipk_, psb_lpk_, psb_zspmat_type
|
||||
@@ -1215,6 +1227,14 @@ module psb_z_mat_mod
|
||||
end subroutine psb_lz_set_triangle
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_lz_set_symmetric(a,val)
|
||||
import :: psb_ipk_, psb_lzspmat_type
|
||||
class(psb_lzspmat_type), intent(inout) :: a
|
||||
logical, intent(in), optional :: val
|
||||
end subroutine psb_lz_set_symmetric
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_lz_set_unit(a,val)
|
||||
import :: psb_ipk_, psb_lpk_, psb_lzspmat_type
|
||||
@@ -1873,6 +1893,19 @@ contains
|
||||
|
||||
end function psb_z_is_triangle
|
||||
|
||||
function psb_z_is_symmetric(a) result(res)
|
||||
implicit none
|
||||
class(psb_zspmat_type), intent(in) :: a
|
||||
logical :: res
|
||||
|
||||
if (allocated(a%a)) then
|
||||
res = a%a%is_symmetric()
|
||||
else
|
||||
res = .false.
|
||||
end if
|
||||
|
||||
end function psb_z_is_symmetric
|
||||
|
||||
function psb_z_is_unit(a) result(res)
|
||||
implicit none
|
||||
class(psb_zspmat_type), intent(in) :: a
|
||||
@@ -2370,6 +2403,20 @@ contains
|
||||
|
||||
end function psb_lz_is_triangle
|
||||
|
||||
|
||||
function psb_lz_is_symmetric(a) result(res)
|
||||
implicit none
|
||||
class(psb_lzspmat_type), intent(in) :: a
|
||||
logical :: res
|
||||
|
||||
if (allocated(a%a)) then
|
||||
res = a%a%is_symmetric()
|
||||
else
|
||||
res = .false.
|
||||
end if
|
||||
|
||||
end function psb_lz_is_symmetric
|
||||
|
||||
function psb_lz_is_unit(a) result(res)
|
||||
implicit none
|
||||
class(psb_lzspmat_type), intent(in) :: a
|
||||
|
||||
@@ -326,6 +326,34 @@ subroutine psb_c_set_triangle(a,val)
|
||||
|
||||
end subroutine psb_c_set_triangle
|
||||
|
||||
subroutine psb_c_set_symmetric(a,val)
|
||||
use psb_c_mat_mod, psb_protect_name => psb_c_set_symmetric
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
class(psb_cspmat_type), intent(inout) :: a
|
||||
logical, intent(in), optional :: val
|
||||
integer(psb_ipk_) :: err_act, info
|
||||
character(len=20) :: name='get_nzeros'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
if (.not.allocated(a%a)) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
call a%a%set_symmetric(val)
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
end subroutine psb_c_set_symmetric
|
||||
|
||||
subroutine psb_c_set_unit(a,val)
|
||||
use psb_c_mat_mod, psb_protect_name => psb_c_set_unit
|
||||
@@ -2848,6 +2876,34 @@ subroutine psb_lc_set_triangle(a,val)
|
||||
|
||||
end subroutine psb_lc_set_triangle
|
||||
|
||||
subroutine psb_lc_set_symmetric(a,val)
|
||||
use psb_c_mat_mod, psb_protect_name => psb_lc_set_symmetric
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
class(psb_lcspmat_type), intent(inout) :: a
|
||||
logical, intent(in), optional :: val
|
||||
integer(psb_ipk_) :: err_act, info
|
||||
character(len=20) :: name='get_nzeros'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
if (.not.allocated(a%a)) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
call a%a%set_symmetric(val)
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
end subroutine psb_lc_set_symmetric
|
||||
|
||||
subroutine psb_lc_set_unit(a,val)
|
||||
use psb_c_mat_mod, psb_protect_name => psb_lc_set_unit
|
||||
|
||||
@@ -326,6 +326,34 @@ subroutine psb_d_set_triangle(a,val)
|
||||
|
||||
end subroutine psb_d_set_triangle
|
||||
|
||||
subroutine psb_d_set_symmetric(a,val)
|
||||
use psb_d_mat_mod, psb_protect_name => psb_d_set_symmetric
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
class(psb_dspmat_type), intent(inout) :: a
|
||||
logical, intent(in), optional :: val
|
||||
integer(psb_ipk_) :: err_act, info
|
||||
character(len=20) :: name='get_nzeros'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
if (.not.allocated(a%a)) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
call a%a%set_symmetric(val)
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
end subroutine psb_d_set_symmetric
|
||||
|
||||
subroutine psb_d_set_unit(a,val)
|
||||
use psb_d_mat_mod, psb_protect_name => psb_d_set_unit
|
||||
@@ -2848,6 +2876,34 @@ subroutine psb_ld_set_triangle(a,val)
|
||||
|
||||
end subroutine psb_ld_set_triangle
|
||||
|
||||
subroutine psb_ld_set_symmetric(a,val)
|
||||
use psb_d_mat_mod, psb_protect_name => psb_ld_set_symmetric
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
class(psb_ldspmat_type), intent(inout) :: a
|
||||
logical, intent(in), optional :: val
|
||||
integer(psb_ipk_) :: err_act, info
|
||||
character(len=20) :: name='get_nzeros'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
if (.not.allocated(a%a)) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
call a%a%set_symmetric(val)
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
end subroutine psb_ld_set_symmetric
|
||||
|
||||
subroutine psb_ld_set_unit(a,val)
|
||||
use psb_d_mat_mod, psb_protect_name => psb_ld_set_unit
|
||||
|
||||
@@ -326,6 +326,34 @@ subroutine psb_s_set_triangle(a,val)
|
||||
|
||||
end subroutine psb_s_set_triangle
|
||||
|
||||
subroutine psb_s_set_symmetric(a,val)
|
||||
use psb_s_mat_mod, psb_protect_name => psb_s_set_symmetric
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
class(psb_sspmat_type), intent(inout) :: a
|
||||
logical, intent(in), optional :: val
|
||||
integer(psb_ipk_) :: err_act, info
|
||||
character(len=20) :: name='get_nzeros'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
if (.not.allocated(a%a)) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
call a%a%set_symmetric(val)
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
end subroutine psb_s_set_symmetric
|
||||
|
||||
subroutine psb_s_set_unit(a,val)
|
||||
use psb_s_mat_mod, psb_protect_name => psb_s_set_unit
|
||||
@@ -2848,6 +2876,34 @@ subroutine psb_ls_set_triangle(a,val)
|
||||
|
||||
end subroutine psb_ls_set_triangle
|
||||
|
||||
subroutine psb_ls_set_symmetric(a,val)
|
||||
use psb_s_mat_mod, psb_protect_name => psb_ls_set_symmetric
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
class(psb_lsspmat_type), intent(inout) :: a
|
||||
logical, intent(in), optional :: val
|
||||
integer(psb_ipk_) :: err_act, info
|
||||
character(len=20) :: name='get_nzeros'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
if (.not.allocated(a%a)) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
call a%a%set_symmetric(val)
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
end subroutine psb_ls_set_symmetric
|
||||
|
||||
subroutine psb_ls_set_unit(a,val)
|
||||
use psb_s_mat_mod, psb_protect_name => psb_ls_set_unit
|
||||
|
||||
@@ -326,6 +326,34 @@ subroutine psb_z_set_triangle(a,val)
|
||||
|
||||
end subroutine psb_z_set_triangle
|
||||
|
||||
subroutine psb_z_set_symmetric(a,val)
|
||||
use psb_z_mat_mod, psb_protect_name => psb_z_set_symmetric
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
class(psb_zspmat_type), intent(inout) :: a
|
||||
logical, intent(in), optional :: val
|
||||
integer(psb_ipk_) :: err_act, info
|
||||
character(len=20) :: name='get_nzeros'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
if (.not.allocated(a%a)) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
call a%a%set_symmetric(val)
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
end subroutine psb_z_set_symmetric
|
||||
|
||||
subroutine psb_z_set_unit(a,val)
|
||||
use psb_z_mat_mod, psb_protect_name => psb_z_set_unit
|
||||
@@ -2848,6 +2876,34 @@ subroutine psb_lz_set_triangle(a,val)
|
||||
|
||||
end subroutine psb_lz_set_triangle
|
||||
|
||||
subroutine psb_lz_set_symmetric(a,val)
|
||||
use psb_z_mat_mod, psb_protect_name => psb_lz_set_symmetric
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
class(psb_lzspmat_type), intent(inout) :: a
|
||||
logical, intent(in), optional :: val
|
||||
integer(psb_ipk_) :: err_act, info
|
||||
character(len=20) :: name='get_nzeros'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
if (.not.allocated(a%a)) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
call a%a%set_symmetric(val)
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
end subroutine psb_lz_set_symmetric
|
||||
|
||||
subroutine psb_lz_set_unit(a,val)
|
||||
use psb_z_mat_mod, psb_protect_name => psb_lz_set_unit
|
||||
|
||||
Reference in New Issue
Block a user