diff --git a/base/modules/auxil/psb_c_realloc_mod.F90 b/base/modules/auxil/psb_c_realloc_mod.F90 index b9f3642b..e8f169d8 100644 --- a/base/modules/auxil/psb_c_realloc_mod.F90 +++ b/base/modules/auxil/psb_c_realloc_mod.F90 @@ -39,6 +39,7 @@ module psb_c_realloc_mod ! the size specified, possibly shortening it. ! Interface psb_realloc + module procedure psb_r_c_s module procedure psb_r_m_c_rk1 module procedure psb_r_m_c_rk2 module procedure psb_r_e_c_rk1 @@ -56,7 +57,7 @@ module psb_c_realloc_mod end interface psb_move_alloc Interface psb_safe_ab_cpy - module procedure psb_ab_cpy_c_rk1, psb_ab_cpy_c_rk2 + module procedure psb_ab_cpy_c_s, psb_ab_cpy_c_rk1, psb_ab_cpy_c_rk2 end Interface psb_safe_ab_cpy Interface psb_safe_cpy @@ -82,6 +83,42 @@ module psb_c_realloc_mod Contains + Subroutine psb_r_c_s(rrax,info) + use psb_error_mod + + ! ...Subroutine Arguments + complex(psb_spk_), allocatable, intent(inout) :: rrax + integer(psb_ipk_) :: info + + ! ...Local Variables + integer(psb_ipk_) :: err_act,err + character(len=20) :: name + logical, parameter :: debug=.false. + + name='psb_r_c_s' + call psb_erractionsave(err_act) + info=psb_success_ + + if (.not.allocated(rrax)) then + Allocate(rrax,stat=info) + if (info /= psb_success_) then + err=4025 + call psb_errpush(err,name, l_err=(/1_psb_lpk_/), & + & a_err='complex(psb_spk_)') + goto 9999 + end if + endif + + call psb_erractionrestore(err_act) + return + +9999 continue + info = err + call psb_error_handler(err_act) + return + + End Subroutine psb_r_c_s + Subroutine psb_r_m_c_rk1(len,rrax,info,pad,lb) use psb_error_mod @@ -687,6 +724,48 @@ Contains + subroutine psb_ab_cpy_c_s(vin,vout,info) + use psb_error_mod + + ! ...Subroutine Arguments + complex(psb_spk_), allocatable, intent(in) :: vin + complex(psb_spk_), allocatable, intent(out) :: vout + integer(psb_ipk_) :: info + ! ...Local Variables + + integer(psb_ipk_) :: isz,err_act,lb + character(len=20) :: name, char_err + logical, parameter :: debug=.false. + + name='psb_ab_cpy_c_s' + call psb_erractionsave(err_act) + info=psb_success_ + if(psb_errstatus_fatal()) then + info=psb_err_from_subroutine_ + goto 9999 + end if + + if (allocated(vin)) then + call psb_realloc(vout,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + char_err='psb_realloc' + call psb_errpush(info,name,a_err=char_err) + goto 9999 + else + vout = vin + endif + endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + + end subroutine psb_ab_cpy_c_s + subroutine psb_ab_cpy_c_rk1(vin,vout,info) use psb_error_mod diff --git a/base/modules/auxil/psb_d_realloc_mod.F90 b/base/modules/auxil/psb_d_realloc_mod.F90 index 43ac9125..f8326f41 100644 --- a/base/modules/auxil/psb_d_realloc_mod.F90 +++ b/base/modules/auxil/psb_d_realloc_mod.F90 @@ -39,6 +39,7 @@ module psb_d_realloc_mod ! the size specified, possibly shortening it. ! Interface psb_realloc + module procedure psb_r_d_s module procedure psb_r_m_d_rk1 module procedure psb_r_m_d_rk2 module procedure psb_r_e_d_rk1 @@ -56,7 +57,7 @@ module psb_d_realloc_mod end interface psb_move_alloc Interface psb_safe_ab_cpy - module procedure psb_ab_cpy_d_rk1, psb_ab_cpy_d_rk2 + module procedure psb_ab_cpy_d_s, psb_ab_cpy_d_rk1, psb_ab_cpy_d_rk2 end Interface psb_safe_ab_cpy Interface psb_safe_cpy @@ -82,6 +83,42 @@ module psb_d_realloc_mod Contains + Subroutine psb_r_d_s(rrax,info) + use psb_error_mod + + ! ...Subroutine Arguments + real(psb_dpk_), allocatable, intent(inout) :: rrax + integer(psb_ipk_) :: info + + ! ...Local Variables + integer(psb_ipk_) :: err_act,err + character(len=20) :: name + logical, parameter :: debug=.false. + + name='psb_r_d_s' + call psb_erractionsave(err_act) + info=psb_success_ + + if (.not.allocated(rrax)) then + Allocate(rrax,stat=info) + if (info /= psb_success_) then + err=4025 + call psb_errpush(err,name, l_err=(/1_psb_lpk_/), & + & a_err='real(psb_dpk_)') + goto 9999 + end if + endif + + call psb_erractionrestore(err_act) + return + +9999 continue + info = err + call psb_error_handler(err_act) + return + + End Subroutine psb_r_d_s + Subroutine psb_r_m_d_rk1(len,rrax,info,pad,lb) use psb_error_mod @@ -687,6 +724,48 @@ Contains + subroutine psb_ab_cpy_d_s(vin,vout,info) + use psb_error_mod + + ! ...Subroutine Arguments + real(psb_dpk_), allocatable, intent(in) :: vin + real(psb_dpk_), allocatable, intent(out) :: vout + integer(psb_ipk_) :: info + ! ...Local Variables + + integer(psb_ipk_) :: isz,err_act,lb + character(len=20) :: name, char_err + logical, parameter :: debug=.false. + + name='psb_ab_cpy_d_s' + call psb_erractionsave(err_act) + info=psb_success_ + if(psb_errstatus_fatal()) then + info=psb_err_from_subroutine_ + goto 9999 + end if + + if (allocated(vin)) then + call psb_realloc(vout,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + char_err='psb_realloc' + call psb_errpush(info,name,a_err=char_err) + goto 9999 + else + vout = vin + endif + endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + + end subroutine psb_ab_cpy_d_s + subroutine psb_ab_cpy_d_rk1(vin,vout,info) use psb_error_mod diff --git a/base/modules/auxil/psb_e_realloc_mod.F90 b/base/modules/auxil/psb_e_realloc_mod.F90 index 56e04dfb..4ad49a2c 100644 --- a/base/modules/auxil/psb_e_realloc_mod.F90 +++ b/base/modules/auxil/psb_e_realloc_mod.F90 @@ -39,6 +39,7 @@ module psb_e_realloc_mod ! the size specified, possibly shortening it. ! Interface psb_realloc + module procedure psb_r_e_s module procedure psb_r_m_e_rk1 module procedure psb_r_m_e_rk2 module procedure psb_r_e_e_rk1 @@ -56,7 +57,7 @@ module psb_e_realloc_mod end interface psb_move_alloc Interface psb_safe_ab_cpy - module procedure psb_ab_cpy_e_rk1, psb_ab_cpy_e_rk2 + module procedure psb_ab_cpy_e_s, psb_ab_cpy_e_rk1, psb_ab_cpy_e_rk2 end Interface psb_safe_ab_cpy Interface psb_safe_cpy @@ -82,6 +83,42 @@ module psb_e_realloc_mod Contains + Subroutine psb_r_e_s(rrax,info) + use psb_error_mod + + ! ...Subroutine Arguments + integer(psb_epk_), allocatable, intent(inout) :: rrax + integer(psb_ipk_) :: info + + ! ...Local Variables + integer(psb_ipk_) :: err_act,err + character(len=20) :: name + logical, parameter :: debug=.false. + + name='psb_r_e_s' + call psb_erractionsave(err_act) + info=psb_success_ + + if (.not.allocated(rrax)) then + Allocate(rrax,stat=info) + if (info /= psb_success_) then + err=4025 + call psb_errpush(err,name, l_err=(/1_psb_lpk_/), & + & a_err='integer(psb_epk_)') + goto 9999 + end if + endif + + call psb_erractionrestore(err_act) + return + +9999 continue + info = err + call psb_error_handler(err_act) + return + + End Subroutine psb_r_e_s + Subroutine psb_r_m_e_rk1(len,rrax,info,pad,lb) use psb_error_mod @@ -687,6 +724,48 @@ Contains + subroutine psb_ab_cpy_e_s(vin,vout,info) + use psb_error_mod + + ! ...Subroutine Arguments + integer(psb_epk_), allocatable, intent(in) :: vin + integer(psb_epk_), allocatable, intent(out) :: vout + integer(psb_ipk_) :: info + ! ...Local Variables + + integer(psb_ipk_) :: isz,err_act,lb + character(len=20) :: name, char_err + logical, parameter :: debug=.false. + + name='psb_ab_cpy_e_s' + call psb_erractionsave(err_act) + info=psb_success_ + if(psb_errstatus_fatal()) then + info=psb_err_from_subroutine_ + goto 9999 + end if + + if (allocated(vin)) then + call psb_realloc(vout,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + char_err='psb_realloc' + call psb_errpush(info,name,a_err=char_err) + goto 9999 + else + vout = vin + endif + endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + + end subroutine psb_ab_cpy_e_s + subroutine psb_ab_cpy_e_rk1(vin,vout,info) use psb_error_mod diff --git a/base/modules/auxil/psb_i2_realloc_mod.F90 b/base/modules/auxil/psb_i2_realloc_mod.F90 index 4bc4da32..6528372f 100644 --- a/base/modules/auxil/psb_i2_realloc_mod.F90 +++ b/base/modules/auxil/psb_i2_realloc_mod.F90 @@ -39,6 +39,7 @@ module psb_i2_realloc_mod ! the size specified, possibly shortening it. ! Interface psb_realloc + module procedure psb_r_i2_s module procedure psb_r_m_i2_rk1 module procedure psb_r_m_i2_rk2 module procedure psb_r_e_i2_rk1 @@ -56,7 +57,7 @@ module psb_i2_realloc_mod end interface psb_move_alloc Interface psb_safe_ab_cpy - module procedure psb_ab_cpy_i2_rk1, psb_ab_cpy_i2_rk2 + module procedure psb_ab_cpy_i2_s, psb_ab_cpy_i2_rk1, psb_ab_cpy_i2_rk2 end Interface psb_safe_ab_cpy Interface psb_safe_cpy @@ -82,6 +83,42 @@ module psb_i2_realloc_mod Contains + Subroutine psb_r_i2_s(rrax,info) + use psb_error_mod + + ! ...Subroutine Arguments + integer(psb_i2pk_), allocatable, intent(inout) :: rrax + integer(psb_ipk_) :: info + + ! ...Local Variables + integer(psb_ipk_) :: err_act,err + character(len=20) :: name + logical, parameter :: debug=.false. + + name='psb_r_i2_s' + call psb_erractionsave(err_act) + info=psb_success_ + + if (.not.allocated(rrax)) then + Allocate(rrax,stat=info) + if (info /= psb_success_) then + err=4025 + call psb_errpush(err,name, l_err=(/1_psb_lpk_/), & + & a_err='integer(psb_i2pk_)') + goto 9999 + end if + endif + + call psb_erractionrestore(err_act) + return + +9999 continue + info = err + call psb_error_handler(err_act) + return + + End Subroutine psb_r_i2_s + Subroutine psb_r_m_i2_rk1(len,rrax,info,pad,lb) use psb_error_mod @@ -687,6 +724,48 @@ Contains + subroutine psb_ab_cpy_i2_s(vin,vout,info) + use psb_error_mod + + ! ...Subroutine Arguments + integer(psb_i2pk_), allocatable, intent(in) :: vin + integer(psb_i2pk_), allocatable, intent(out) :: vout + integer(psb_ipk_) :: info + ! ...Local Variables + + integer(psb_ipk_) :: isz,err_act,lb + character(len=20) :: name, char_err + logical, parameter :: debug=.false. + + name='psb_ab_cpy_i2_s' + call psb_erractionsave(err_act) + info=psb_success_ + if(psb_errstatus_fatal()) then + info=psb_err_from_subroutine_ + goto 9999 + end if + + if (allocated(vin)) then + call psb_realloc(vout,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + char_err='psb_realloc' + call psb_errpush(info,name,a_err=char_err) + goto 9999 + else + vout = vin + endif + endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + + end subroutine psb_ab_cpy_i2_s + subroutine psb_ab_cpy_i2_rk1(vin,vout,info) use psb_error_mod diff --git a/base/modules/auxil/psb_m_realloc_mod.F90 b/base/modules/auxil/psb_m_realloc_mod.F90 index 993be571..b60e7ae2 100644 --- a/base/modules/auxil/psb_m_realloc_mod.F90 +++ b/base/modules/auxil/psb_m_realloc_mod.F90 @@ -39,6 +39,7 @@ module psb_m_realloc_mod ! the size specified, possibly shortening it. ! Interface psb_realloc + module procedure psb_r_m_s module procedure psb_r_m_m_rk1 module procedure psb_r_m_m_rk2 module procedure psb_r_e_m_rk1 @@ -56,7 +57,7 @@ module psb_m_realloc_mod end interface psb_move_alloc Interface psb_safe_ab_cpy - module procedure psb_ab_cpy_m_rk1, psb_ab_cpy_m_rk2 + module procedure psb_ab_cpy_m_s, psb_ab_cpy_m_rk1, psb_ab_cpy_m_rk2 end Interface psb_safe_ab_cpy Interface psb_safe_cpy @@ -82,6 +83,42 @@ module psb_m_realloc_mod Contains + Subroutine psb_r_m_s(rrax,info) + use psb_error_mod + + ! ...Subroutine Arguments + integer(psb_mpk_), allocatable, intent(inout) :: rrax + integer(psb_ipk_) :: info + + ! ...Local Variables + integer(psb_ipk_) :: err_act,err + character(len=20) :: name + logical, parameter :: debug=.false. + + name='psb_r_m_s' + call psb_erractionsave(err_act) + info=psb_success_ + + if (.not.allocated(rrax)) then + Allocate(rrax,stat=info) + if (info /= psb_success_) then + err=4025 + call psb_errpush(err,name, l_err=(/1_psb_lpk_/), & + & a_err='integer(psb_mpk_)') + goto 9999 + end if + endif + + call psb_erractionrestore(err_act) + return + +9999 continue + info = err + call psb_error_handler(err_act) + return + + End Subroutine psb_r_m_s + Subroutine psb_r_m_m_rk1(len,rrax,info,pad,lb) use psb_error_mod @@ -687,6 +724,48 @@ Contains + subroutine psb_ab_cpy_m_s(vin,vout,info) + use psb_error_mod + + ! ...Subroutine Arguments + integer(psb_mpk_), allocatable, intent(in) :: vin + integer(psb_mpk_), allocatable, intent(out) :: vout + integer(psb_ipk_) :: info + ! ...Local Variables + + integer(psb_ipk_) :: isz,err_act,lb + character(len=20) :: name, char_err + logical, parameter :: debug=.false. + + name='psb_ab_cpy_m_s' + call psb_erractionsave(err_act) + info=psb_success_ + if(psb_errstatus_fatal()) then + info=psb_err_from_subroutine_ + goto 9999 + end if + + if (allocated(vin)) then + call psb_realloc(vout,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + char_err='psb_realloc' + call psb_errpush(info,name,a_err=char_err) + goto 9999 + else + vout = vin + endif + endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + + end subroutine psb_ab_cpy_m_s + subroutine psb_ab_cpy_m_rk1(vin,vout,info) use psb_error_mod diff --git a/base/modules/auxil/psb_s_realloc_mod.F90 b/base/modules/auxil/psb_s_realloc_mod.F90 index 4d29a28a..f7cfdbfe 100644 --- a/base/modules/auxil/psb_s_realloc_mod.F90 +++ b/base/modules/auxil/psb_s_realloc_mod.F90 @@ -39,6 +39,7 @@ module psb_s_realloc_mod ! the size specified, possibly shortening it. ! Interface psb_realloc + module procedure psb_r_s_s module procedure psb_r_m_s_rk1 module procedure psb_r_m_s_rk2 module procedure psb_r_e_s_rk1 @@ -56,7 +57,7 @@ module psb_s_realloc_mod end interface psb_move_alloc Interface psb_safe_ab_cpy - module procedure psb_ab_cpy_s_rk1, psb_ab_cpy_s_rk2 + module procedure psb_ab_cpy_s_s, psb_ab_cpy_s_rk1, psb_ab_cpy_s_rk2 end Interface psb_safe_ab_cpy Interface psb_safe_cpy @@ -82,6 +83,42 @@ module psb_s_realloc_mod Contains + Subroutine psb_r_s_s(rrax,info) + use psb_error_mod + + ! ...Subroutine Arguments + real(psb_spk_), allocatable, intent(inout) :: rrax + integer(psb_ipk_) :: info + + ! ...Local Variables + integer(psb_ipk_) :: err_act,err + character(len=20) :: name + logical, parameter :: debug=.false. + + name='psb_r_s_s' + call psb_erractionsave(err_act) + info=psb_success_ + + if (.not.allocated(rrax)) then + Allocate(rrax,stat=info) + if (info /= psb_success_) then + err=4025 + call psb_errpush(err,name, l_err=(/1_psb_lpk_/), & + & a_err='real(psb_spk_)') + goto 9999 + end if + endif + + call psb_erractionrestore(err_act) + return + +9999 continue + info = err + call psb_error_handler(err_act) + return + + End Subroutine psb_r_s_s + Subroutine psb_r_m_s_rk1(len,rrax,info,pad,lb) use psb_error_mod @@ -687,6 +724,48 @@ Contains + subroutine psb_ab_cpy_s_s(vin,vout,info) + use psb_error_mod + + ! ...Subroutine Arguments + real(psb_spk_), allocatable, intent(in) :: vin + real(psb_spk_), allocatable, intent(out) :: vout + integer(psb_ipk_) :: info + ! ...Local Variables + + integer(psb_ipk_) :: isz,err_act,lb + character(len=20) :: name, char_err + logical, parameter :: debug=.false. + + name='psb_ab_cpy_s_s' + call psb_erractionsave(err_act) + info=psb_success_ + if(psb_errstatus_fatal()) then + info=psb_err_from_subroutine_ + goto 9999 + end if + + if (allocated(vin)) then + call psb_realloc(vout,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + char_err='psb_realloc' + call psb_errpush(info,name,a_err=char_err) + goto 9999 + else + vout = vin + endif + endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + + end subroutine psb_ab_cpy_s_s + subroutine psb_ab_cpy_s_rk1(vin,vout,info) use psb_error_mod diff --git a/base/modules/auxil/psb_z_realloc_mod.F90 b/base/modules/auxil/psb_z_realloc_mod.F90 index bf849a1e..230d4f8e 100644 --- a/base/modules/auxil/psb_z_realloc_mod.F90 +++ b/base/modules/auxil/psb_z_realloc_mod.F90 @@ -39,6 +39,7 @@ module psb_z_realloc_mod ! the size specified, possibly shortening it. ! Interface psb_realloc + module procedure psb_r_z_s module procedure psb_r_m_z_rk1 module procedure psb_r_m_z_rk2 module procedure psb_r_e_z_rk1 @@ -56,7 +57,7 @@ module psb_z_realloc_mod end interface psb_move_alloc Interface psb_safe_ab_cpy - module procedure psb_ab_cpy_z_rk1, psb_ab_cpy_z_rk2 + module procedure psb_ab_cpy_z_s, psb_ab_cpy_z_rk1, psb_ab_cpy_z_rk2 end Interface psb_safe_ab_cpy Interface psb_safe_cpy @@ -82,6 +83,42 @@ module psb_z_realloc_mod Contains + Subroutine psb_r_z_s(rrax,info) + use psb_error_mod + + ! ...Subroutine Arguments + complex(psb_dpk_), allocatable, intent(inout) :: rrax + integer(psb_ipk_) :: info + + ! ...Local Variables + integer(psb_ipk_) :: err_act,err + character(len=20) :: name + logical, parameter :: debug=.false. + + name='psb_r_z_s' + call psb_erractionsave(err_act) + info=psb_success_ + + if (.not.allocated(rrax)) then + Allocate(rrax,stat=info) + if (info /= psb_success_) then + err=4025 + call psb_errpush(err,name, l_err=(/1_psb_lpk_/), & + & a_err='complex(psb_dpk_)') + goto 9999 + end if + endif + + call psb_erractionrestore(err_act) + return + +9999 continue + info = err + call psb_error_handler(err_act) + return + + End Subroutine psb_r_z_s + Subroutine psb_r_m_z_rk1(len,rrax,info,pad,lb) use psb_error_mod @@ -687,6 +724,48 @@ Contains + subroutine psb_ab_cpy_z_s(vin,vout,info) + use psb_error_mod + + ! ...Subroutine Arguments + complex(psb_dpk_), allocatable, intent(in) :: vin + complex(psb_dpk_), allocatable, intent(out) :: vout + integer(psb_ipk_) :: info + ! ...Local Variables + + integer(psb_ipk_) :: isz,err_act,lb + character(len=20) :: name, char_err + logical, parameter :: debug=.false. + + name='psb_ab_cpy_z_s' + call psb_erractionsave(err_act) + info=psb_success_ + if(psb_errstatus_fatal()) then + info=psb_err_from_subroutine_ + goto 9999 + end if + + if (allocated(vin)) then + call psb_realloc(vout,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + char_err='psb_realloc' + call psb_errpush(info,name,a_err=char_err) + goto 9999 + else + vout = vin + endif + endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + + end subroutine psb_ab_cpy_z_s + subroutine psb_ab_cpy_z_rk1(vin,vout,info) use psb_error_mod