From 6120b6fe48bace4ceeac65af41cae6dc1f275b94 Mon Sep 17 00:00:00 2001 From: Cirdans-Home Date: Tue, 6 Dec 2022 00:17:08 +0100 Subject: [PATCH] Implemented copy to/from real --- base/modules/Makefile | 4 ++ base/modules/serial/psb_c_base_vect_mod.F90 | 58 ++++++++++++++++++++- base/modules/serial/psb_c_mat_mod.F90 | 1 - base/modules/serial/psb_c_vect_mod.F90 | 49 +++++++++++++++++ base/modules/serial/psb_d_base_vect_mod.F90 | 6 ++- base/modules/serial/psb_d_mat_mod.F90 | 1 - base/modules/serial/psb_d_vect_mod.F90 | 3 ++ base/modules/serial/psb_i_base_vect_mod.F90 | 6 ++- base/modules/serial/psb_i_vect_mod.F90 | 3 ++ base/modules/serial/psb_l_base_vect_mod.F90 | 6 ++- base/modules/serial/psb_l_vect_mod.F90 | 3 ++ base/modules/serial/psb_s_base_vect_mod.F90 | 6 ++- base/modules/serial/psb_s_mat_mod.F90 | 1 - base/modules/serial/psb_s_vect_mod.F90 | 3 ++ base/modules/serial/psb_z_base_vect_mod.F90 | 58 ++++++++++++++++++++- base/modules/serial/psb_z_mat_mod.F90 | 1 - base/modules/serial/psb_z_vect_mod.F90 | 49 +++++++++++++++++ 17 files changed, 248 insertions(+), 10 deletions(-) diff --git a/base/modules/Makefile b/base/modules/Makefile index 7d9874a2..f76221ee 100644 --- a/base/modules/Makefile +++ b/base/modules/Makefile @@ -274,6 +274,10 @@ serial/psb_c_vect_mod.o: serial/psb_c_base_vect_mod.o serial/psb_i_vect_mod.o serial/psb_z_vect_mod.o: serial/psb_z_base_vect_mod.o serial/psb_i_vect_mod.o serial/psb_s_serial_mod.o serial/psb_d_serial_mod.o serial/psb_c_serial_mod.o serial/psb_z_serial_mod.o: serial/psb_mat_mod.o auxil/psb_string_mod.o auxil/psb_sort_mod.o auxil/psi_serial_mod.o serial/psb_vect_mod.o: serial/psb_i_vect_mod.o serial/psb_l_vect_mod.o serial/psb_d_vect_mod.o serial/psb_s_vect_mod.o serial/psb_c_vect_mod.o serial/psb_z_vect_mod.o +serial/psb_c_base_vect_mod.o: serial/psb_s_base_vect_mod.o +serial/psb_z_base_vect_mod.o: serial/psb_d_base_vect_mod.o +serial/psb_c_vect_mod.o: serial/psb_s_vect_mod.o +serial/psb_z_vect_mod.o: serial/psb_d_vect_mod.o error.o psb_realloc_mod.o: psb_error_mod.o psb_error_impl.o: psb_penv_mod.o diff --git a/base/modules/serial/psb_c_base_vect_mod.F90 b/base/modules/serial/psb_c_base_vect_mod.F90 index 44044771..5349589d 100644 --- a/base/modules/serial/psb_c_base_vect_mod.F90 +++ b/base/modules/serial/psb_c_base_vect_mod.F90 @@ -47,9 +47,9 @@ module psb_c_base_vect_mod use psb_const_mod use psb_error_mod use psb_realloc_mod + use psb_s_base_vect_mod use psb_i_base_vect_mod use psb_l_base_vect_mod - !> \namespace psb_base_mod \class psb_c_base_vect_type !! The psb_c_base_vect_type !! defines a middle level complex(psb_spk_) encapsulated dense vector. @@ -89,6 +89,11 @@ module psb_c_base_vect_mod generic, public :: asb => asb_m, asb_e procedure, pass(x) :: free => c_base_free ! + ! Copy from/to real vectors + ! + procedure, pass(y) :: copy_to_real => c_copy_to_real + procedure, pass(y) :: copy_from_real => c_copy_from_real + ! ! Sync: centerpiece of handling of external storage. ! Any derived class having extra storage upon sync ! will guarantee that both fortran/host side and @@ -1987,6 +1992,57 @@ contains if (x%is_dev()) call x%sync() call z%addconst(x%v,b,info) end subroutine c_base_addconst_v2 + + ! Copy to and from complex vectors + subroutine c_copy_to_real(x,y,info) + use psi_serial_mod + use psb_s_base_vect_mod + implicit none + class(psb_s_base_vect_type), intent(inout) :: x + class(psb_c_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + + ! Local variables + integer(psb_ipk_) :: err_act + character(len=20) :: name='vec_to_real' + + call psb_erractionsave(err_act) + info = psb_success_ + + if (y%is_dev()) call y%sync() + + x%v = real(y%v, kind=psb_spk_) + + call x%set_host() + + call psb_erractionrestore(err_act) + return + + end subroutine c_copy_to_real + + subroutine c_copy_from_real(x,y,info) + use psi_serial_mod + use psb_s_base_vect_mod + implicit none + class(psb_s_base_vect_type), intent(inout) :: x + class(psb_c_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + + ! Local variables + integer(psb_ipk_) :: err_act + character(len=20) :: name='vec_from_real' + + call psb_erractionsave(err_act) + info = psb_success_ + + if (x%is_dev()) call x%sync() + + y%v = x%v + + call y%set_host() + + end subroutine c_copy_from_real + end module psb_c_base_vect_mod diff --git a/base/modules/serial/psb_c_mat_mod.F90 b/base/modules/serial/psb_c_mat_mod.F90 index fd423de3..20ca177f 100644 --- a/base/modules/serial/psb_c_mat_mod.F90 +++ b/base/modules/serial/psb_c_mat_mod.F90 @@ -81,7 +81,6 @@ module psb_c_mat_mod use psb_c_base_mat_mod use psb_c_csr_mat_mod, only : psb_c_csr_sparse_mat, psb_lc_csr_sparse_mat use psb_c_csc_mat_mod, only : psb_c_csc_sparse_mat, psb_lc_csc_sparse_mat - type :: psb_cspmat_type class(psb_c_base_sparse_mat), allocatable :: a diff --git a/base/modules/serial/psb_c_vect_mod.F90 b/base/modules/serial/psb_c_vect_mod.F90 index 1a336d11..e79e9d89 100644 --- a/base/modules/serial/psb_c_vect_mod.F90 +++ b/base/modules/serial/psb_c_vect_mod.F90 @@ -41,6 +41,7 @@ module psb_c_vect_mod use psb_realloc_mod use psb_c_base_vect_mod + use psb_s_vect_mod use psb_i_vect_mod type psb_c_vect_type @@ -83,6 +84,11 @@ module psb_c_vect_mod procedure, pass(x) :: set_vect => c_vect_set_vect generic, public :: set => set_vect, set_scal procedure, pass(x) :: clone => c_vect_clone + ! + ! Copy from/to real vectors + ! + procedure, pass(y) :: copy_to_real => c_vect_copy_to_real + procedure, pass(y) :: copy_from_real => c_vect_copy_from_real procedure, pass(x) :: sync => c_vect_sync procedure, pass(x) :: is_host => c_vect_is_host @@ -141,6 +147,8 @@ module psb_c_vect_mod generic, public :: addconst => addconst_a2, addconst_v2 + + end type psb_c_vect_type public :: psb_c_vect @@ -381,6 +389,47 @@ contains end subroutine c_vect_set_vect + subroutine c_vect_copy_to_real(x,y,info) + use psb_s_vect_mod + implicit none + class(psb_s_vect_type), intent(inout) :: x + class(psb_c_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + + ! Local variables + integer(psb_ipk_) :: err_act + character(len=20) :: name='vec_to_real' + + call psb_erractionsave(err_act) + info = psb_err_alloc_dealloc_ + + if( allocated(y%v) ) & + & call y%v%copy_to_real(x%v,info) + + return + end subroutine c_vect_copy_to_real + + subroutine c_vect_copy_from_real(x,y,info) + use psb_s_vect_mod + implicit none + class(psb_s_vect_type), intent(inout) :: x + class(psb_c_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + + ! Local variables + integer(psb_ipk_) :: err_act + character(len=20) :: name='vec_to_real' + + call psb_erractionsave(err_act) + info = psb_err_alloc_dealloc_ + + if( allocated(y%v) ) & + & call y%v%copy_from_real(x%v,info) + + return + + end subroutine c_vect_copy_from_real + function constructor(x) result(this) complex(psb_spk_) :: x(:) diff --git a/base/modules/serial/psb_d_base_vect_mod.F90 b/base/modules/serial/psb_d_base_vect_mod.F90 index a28d12f6..b7d207a8 100644 --- a/base/modules/serial/psb_d_base_vect_mod.F90 +++ b/base/modules/serial/psb_d_base_vect_mod.F90 @@ -49,7 +49,6 @@ module psb_d_base_vect_mod use psb_realloc_mod use psb_i_base_vect_mod use psb_l_base_vect_mod - !> \namespace psb_base_mod \class psb_d_base_vect_type !! The psb_d_base_vect_type !! defines a middle level real(psb_dpk_) encapsulated dense vector. @@ -89,6 +88,9 @@ module psb_d_base_vect_mod generic, public :: asb => asb_m, asb_e procedure, pass(x) :: free => d_base_free ! + ! Copy from/to real vectors + ! + ! ! Sync: centerpiece of handling of external storage. ! Any derived class having extra storage upon sync ! will guarantee that both fortran/host side and @@ -2166,6 +2168,8 @@ contains if (x%is_dev()) call x%sync() call z%addconst(x%v,b,info) end subroutine d_base_addconst_v2 + + end module psb_d_base_vect_mod diff --git a/base/modules/serial/psb_d_mat_mod.F90 b/base/modules/serial/psb_d_mat_mod.F90 index 8f967ce1..1907ed84 100644 --- a/base/modules/serial/psb_d_mat_mod.F90 +++ b/base/modules/serial/psb_d_mat_mod.F90 @@ -81,7 +81,6 @@ module psb_d_mat_mod use psb_d_base_mat_mod use psb_d_csr_mat_mod, only : psb_d_csr_sparse_mat, psb_ld_csr_sparse_mat use psb_d_csc_mat_mod, only : psb_d_csc_sparse_mat, psb_ld_csc_sparse_mat - type :: psb_dspmat_type class(psb_d_base_sparse_mat), allocatable :: a diff --git a/base/modules/serial/psb_d_vect_mod.F90 b/base/modules/serial/psb_d_vect_mod.F90 index 88fa3262..a8a784f4 100644 --- a/base/modules/serial/psb_d_vect_mod.F90 +++ b/base/modules/serial/psb_d_vect_mod.F90 @@ -148,6 +148,8 @@ module psb_d_vect_mod procedure, pass(x) :: minquotient_a2 => d_vect_minquotient_a2 generic, public :: minquotient => minquotient_v, minquotient_a2 + + end type psb_d_vect_type public :: psb_d_vect @@ -389,6 +391,7 @@ contains end subroutine d_vect_set_vect + function constructor(x) result(this) real(psb_dpk_) :: x(:) type(psb_d_vect_type) :: this diff --git a/base/modules/serial/psb_i_base_vect_mod.F90 b/base/modules/serial/psb_i_base_vect_mod.F90 index 0289ecd0..b995063e 100644 --- a/base/modules/serial/psb_i_base_vect_mod.F90 +++ b/base/modules/serial/psb_i_base_vect_mod.F90 @@ -47,7 +47,6 @@ module psb_i_base_vect_mod use psb_const_mod use psb_error_mod use psb_realloc_mod - !> \namespace psb_base_mod \class psb_i_base_vect_type !! The psb_i_base_vect_type !! defines a middle level integer(psb_ipk_) encapsulated dense vector. @@ -87,6 +86,9 @@ module psb_i_base_vect_mod generic, public :: asb => asb_m, asb_e procedure, pass(x) :: free => i_base_free ! + ! Copy from/to real vectors + ! + ! ! Sync: centerpiece of handling of external storage. ! Any derived class having extra storage upon sync ! will guarantee that both fortran/host side and @@ -1006,6 +1008,8 @@ contains end subroutine i_base_sctb_buf + + end module psb_i_base_vect_mod diff --git a/base/modules/serial/psb_i_vect_mod.F90 b/base/modules/serial/psb_i_vect_mod.F90 index ab371bd5..968a049f 100644 --- a/base/modules/serial/psb_i_vect_mod.F90 +++ b/base/modules/serial/psb_i_vect_mod.F90 @@ -93,6 +93,8 @@ module psb_i_vect_mod + + end type psb_i_vect_type public :: psb_i_vect @@ -329,6 +331,7 @@ contains end subroutine i_vect_set_vect + function constructor(x) result(this) integer(psb_ipk_) :: x(:) type(psb_i_vect_type) :: this diff --git a/base/modules/serial/psb_l_base_vect_mod.F90 b/base/modules/serial/psb_l_base_vect_mod.F90 index d8654f63..56920a53 100644 --- a/base/modules/serial/psb_l_base_vect_mod.F90 +++ b/base/modules/serial/psb_l_base_vect_mod.F90 @@ -48,7 +48,6 @@ module psb_l_base_vect_mod use psb_error_mod use psb_realloc_mod use psb_i_base_vect_mod - !> \namespace psb_base_mod \class psb_l_base_vect_type !! The psb_l_base_vect_type !! defines a middle level integer(psb_lpk_) encapsulated dense vector. @@ -88,6 +87,9 @@ module psb_l_base_vect_mod generic, public :: asb => asb_m, asb_e procedure, pass(x) :: free => l_base_free ! + ! Copy from/to real vectors + ! + ! ! Sync: centerpiece of handling of external storage. ! Any derived class having extra storage upon sync ! will guarantee that both fortran/host side and @@ -1007,6 +1009,8 @@ contains end subroutine l_base_sctb_buf + + end module psb_l_base_vect_mod diff --git a/base/modules/serial/psb_l_vect_mod.F90 b/base/modules/serial/psb_l_vect_mod.F90 index 779d4723..6576277a 100644 --- a/base/modules/serial/psb_l_vect_mod.F90 +++ b/base/modules/serial/psb_l_vect_mod.F90 @@ -94,6 +94,8 @@ module psb_l_vect_mod + + end type psb_l_vect_type public :: psb_l_vect @@ -330,6 +332,7 @@ contains end subroutine l_vect_set_vect + function constructor(x) result(this) integer(psb_lpk_) :: x(:) type(psb_l_vect_type) :: this diff --git a/base/modules/serial/psb_s_base_vect_mod.F90 b/base/modules/serial/psb_s_base_vect_mod.F90 index 4bd6bbfb..bb4077bb 100644 --- a/base/modules/serial/psb_s_base_vect_mod.F90 +++ b/base/modules/serial/psb_s_base_vect_mod.F90 @@ -49,7 +49,6 @@ module psb_s_base_vect_mod use psb_realloc_mod use psb_i_base_vect_mod use psb_l_base_vect_mod - !> \namespace psb_base_mod \class psb_s_base_vect_type !! The psb_s_base_vect_type !! defines a middle level real(psb_spk_) encapsulated dense vector. @@ -89,6 +88,9 @@ module psb_s_base_vect_mod generic, public :: asb => asb_m, asb_e procedure, pass(x) :: free => s_base_free ! + ! Copy from/to real vectors + ! + ! ! Sync: centerpiece of handling of external storage. ! Any derived class having extra storage upon sync ! will guarantee that both fortran/host side and @@ -2166,6 +2168,8 @@ contains if (x%is_dev()) call x%sync() call z%addconst(x%v,b,info) end subroutine s_base_addconst_v2 + + end module psb_s_base_vect_mod diff --git a/base/modules/serial/psb_s_mat_mod.F90 b/base/modules/serial/psb_s_mat_mod.F90 index 43f1c619..18cd3a75 100644 --- a/base/modules/serial/psb_s_mat_mod.F90 +++ b/base/modules/serial/psb_s_mat_mod.F90 @@ -81,7 +81,6 @@ module psb_s_mat_mod use psb_s_base_mat_mod use psb_s_csr_mat_mod, only : psb_s_csr_sparse_mat, psb_ls_csr_sparse_mat use psb_s_csc_mat_mod, only : psb_s_csc_sparse_mat, psb_ls_csc_sparse_mat - type :: psb_sspmat_type class(psb_s_base_sparse_mat), allocatable :: a diff --git a/base/modules/serial/psb_s_vect_mod.F90 b/base/modules/serial/psb_s_vect_mod.F90 index 7a54ecf0..03555be2 100644 --- a/base/modules/serial/psb_s_vect_mod.F90 +++ b/base/modules/serial/psb_s_vect_mod.F90 @@ -148,6 +148,8 @@ module psb_s_vect_mod procedure, pass(x) :: minquotient_a2 => s_vect_minquotient_a2 generic, public :: minquotient => minquotient_v, minquotient_a2 + + end type psb_s_vect_type public :: psb_s_vect @@ -389,6 +391,7 @@ contains end subroutine s_vect_set_vect + function constructor(x) result(this) real(psb_spk_) :: x(:) type(psb_s_vect_type) :: this diff --git a/base/modules/serial/psb_z_base_vect_mod.F90 b/base/modules/serial/psb_z_base_vect_mod.F90 index c52dcd59..d5215371 100644 --- a/base/modules/serial/psb_z_base_vect_mod.F90 +++ b/base/modules/serial/psb_z_base_vect_mod.F90 @@ -47,9 +47,9 @@ module psb_z_base_vect_mod use psb_const_mod use psb_error_mod use psb_realloc_mod + use psb_d_base_vect_mod use psb_i_base_vect_mod use psb_l_base_vect_mod - !> \namespace psb_base_mod \class psb_z_base_vect_type !! The psb_z_base_vect_type !! defines a middle level complex(psb_dpk_) encapsulated dense vector. @@ -89,6 +89,11 @@ module psb_z_base_vect_mod generic, public :: asb => asb_m, asb_e procedure, pass(x) :: free => z_base_free ! + ! Copy from/to real vectors + ! + procedure, pass(y) :: copy_to_real => z_copy_to_real + procedure, pass(y) :: copy_from_real => z_copy_from_real + ! ! Sync: centerpiece of handling of external storage. ! Any derived class having extra storage upon sync ! will guarantee that both fortran/host side and @@ -1987,6 +1992,57 @@ contains if (x%is_dev()) call x%sync() call z%addconst(x%v,b,info) end subroutine z_base_addconst_v2 + + ! Copy to and from complex vectors + subroutine z_copy_to_real(x,y,info) + use psi_serial_mod + use psb_d_base_vect_mod + implicit none + class(psb_d_base_vect_type), intent(inout) :: x + class(psb_z_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + + ! Local variables + integer(psb_ipk_) :: err_act + character(len=20) :: name='vec_to_real' + + call psb_erractionsave(err_act) + info = psb_success_ + + if (y%is_dev()) call y%sync() + + x%v = real(y%v, kind=psb_dpk_) + + call x%set_host() + + call psb_erractionrestore(err_act) + return + + end subroutine z_copy_to_real + + subroutine z_copy_from_real(x,y,info) + use psi_serial_mod + use psb_d_base_vect_mod + implicit none + class(psb_d_base_vect_type), intent(inout) :: x + class(psb_z_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + + ! Local variables + integer(psb_ipk_) :: err_act + character(len=20) :: name='vec_from_real' + + call psb_erractionsave(err_act) + info = psb_success_ + + if (x%is_dev()) call x%sync() + + y%v = x%v + + call y%set_host() + + end subroutine z_copy_from_real + end module psb_z_base_vect_mod diff --git a/base/modules/serial/psb_z_mat_mod.F90 b/base/modules/serial/psb_z_mat_mod.F90 index fa0358be..08e87890 100644 --- a/base/modules/serial/psb_z_mat_mod.F90 +++ b/base/modules/serial/psb_z_mat_mod.F90 @@ -82,7 +82,6 @@ module psb_z_mat_mod use psb_z_csr_mat_mod, only : psb_z_csr_sparse_mat, psb_lz_csr_sparse_mat use psb_z_csc_mat_mod, only : psb_z_csc_sparse_mat, psb_lz_csc_sparse_mat use psb_z_csrli_mat_mod - type :: psb_zspmat_type class(psb_z_base_sparse_mat), allocatable :: a diff --git a/base/modules/serial/psb_z_vect_mod.F90 b/base/modules/serial/psb_z_vect_mod.F90 index e8a34859..c1caee2d 100644 --- a/base/modules/serial/psb_z_vect_mod.F90 +++ b/base/modules/serial/psb_z_vect_mod.F90 @@ -41,6 +41,7 @@ module psb_z_vect_mod use psb_realloc_mod use psb_z_base_vect_mod + use psb_d_vect_mod use psb_i_vect_mod type psb_z_vect_type @@ -83,6 +84,11 @@ module psb_z_vect_mod procedure, pass(x) :: set_vect => z_vect_set_vect generic, public :: set => set_vect, set_scal procedure, pass(x) :: clone => z_vect_clone + ! + ! Copy from/to real vectors + ! + procedure, pass(y) :: copy_to_real => z_vect_copy_to_real + procedure, pass(y) :: copy_from_real => z_vect_copy_from_real procedure, pass(x) :: sync => z_vect_sync procedure, pass(x) :: is_host => z_vect_is_host @@ -141,6 +147,8 @@ module psb_z_vect_mod generic, public :: addconst => addconst_a2, addconst_v2 + + end type psb_z_vect_type public :: psb_z_vect @@ -381,6 +389,47 @@ contains end subroutine z_vect_set_vect + subroutine z_vect_copy_to_real(x,y,info) + use psb_d_vect_mod + implicit none + class(psb_d_vect_type), intent(inout) :: x + class(psb_z_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + + ! Local variables + integer(psb_ipk_) :: err_act + character(len=20) :: name='vec_to_real' + + call psb_erractionsave(err_act) + info = psb_err_alloc_dealloc_ + + if( allocated(y%v) ) & + & call y%v%copy_to_real(x%v,info) + + return + end subroutine z_vect_copy_to_real + + subroutine z_vect_copy_from_real(x,y,info) + use psb_d_vect_mod + implicit none + class(psb_d_vect_type), intent(inout) :: x + class(psb_z_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + + ! Local variables + integer(psb_ipk_) :: err_act + character(len=20) :: name='vec_to_real' + + call psb_erractionsave(err_act) + info = psb_err_alloc_dealloc_ + + if( allocated(y%v) ) & + & call y%v%copy_from_real(x%v,info) + + return + + end subroutine z_vect_copy_from_real + function constructor(x) result(this) complex(psb_dpk_) :: x(:)