From e500a8a5b5be598da67f591a20b2499ef6ffd8f2 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 10 Nov 2020 10:25:04 +0100 Subject: [PATCH] Factored level%map_rstr and level%map_prol. --- amgprec/amg_c_onelev_mod.f90 | 135 ++++++------------ amgprec/amg_d_onelev_mod.f90 | 135 ++++++------------ amgprec/amg_s_onelev_mod.f90 | 135 ++++++------------ amgprec/amg_z_onelev_mod.f90 | 135 ++++++------------ .../impl/level/amg_c_base_onelev_map_prol.F90 | 85 +++++++++++ .../impl/level/amg_c_base_onelev_map_rstr.F90 | 85 +++++++++++ .../impl/level/amg_d_base_onelev_map_prol.F90 | 85 +++++++++++ .../impl/level/amg_d_base_onelev_map_rstr.F90 | 85 +++++++++++ .../impl/level/amg_s_base_onelev_map_prol.F90 | 85 +++++++++++ .../impl/level/amg_s_base_onelev_map_rstr.F90 | 85 +++++++++++ .../impl/level/amg_z_base_onelev_map_prol.F90 | 85 +++++++++++ .../impl/level/amg_z_base_onelev_map_rstr.F90 | 85 +++++++++++ 12 files changed, 868 insertions(+), 352 deletions(-) create mode 100644 amgprec/impl/level/amg_c_base_onelev_map_prol.F90 create mode 100644 amgprec/impl/level/amg_c_base_onelev_map_rstr.F90 create mode 100644 amgprec/impl/level/amg_d_base_onelev_map_prol.F90 create mode 100644 amgprec/impl/level/amg_d_base_onelev_map_rstr.F90 create mode 100644 amgprec/impl/level/amg_s_base_onelev_map_prol.F90 create mode 100644 amgprec/impl/level/amg_s_base_onelev_map_rstr.F90 create mode 100644 amgprec/impl/level/amg_z_base_onelev_map_prol.F90 create mode 100644 amgprec/impl/level/amg_z_base_onelev_map_rstr.F90 diff --git a/amgprec/amg_c_onelev_mod.f90 b/amgprec/amg_c_onelev_mod.f90 index 82274b82..11f283ea 100644 --- a/amgprec/amg_c_onelev_mod.f90 +++ b/amgprec/amg_c_onelev_mod.f90 @@ -411,6 +411,53 @@ interface logical, optional, intent(in) :: ac, rp, smoother, solver, tprol, global_num end subroutine amg_c_base_onelev_dump end interface + + interface + subroutine amg_c_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work) + import + implicit none + class(amg_c_onelev_type), target, intent(inout) :: lv + complex(psb_spk_), intent(in) :: alpha, beta + complex(psb_spk_), intent(inout) :: u(:) + complex(psb_spk_), intent(out) :: v(:) + integer(psb_ipk_), intent(out) :: info + complex(psb_spk_), optional :: work(:) + end subroutine amg_c_base_onelev_map_rstr_a + subroutine amg_c_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,work,vtx,vty) + import + implicit none + class(amg_c_onelev_type), target, intent(inout) :: lv + complex(psb_spk_), intent(in) :: alpha, beta + type(psb_c_vect_type), intent(inout) :: vect_u, vect_v + integer(psb_ipk_), intent(out) :: info + complex(psb_spk_), optional :: work(:) + type(psb_c_vect_type), optional, target, intent(inout) :: vtx,vty + end subroutine amg_c_base_onelev_map_rstr_v + end interface + + interface + subroutine amg_c_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work) + import + implicit none + class(amg_c_onelev_type), target, intent(inout) :: lv + complex(psb_spk_), intent(in) :: alpha, beta + complex(psb_spk_), intent(inout) :: u(:) + complex(psb_spk_), intent(out) :: v(:) + integer(psb_ipk_), intent(out) :: info + complex(psb_spk_), optional :: work(:) + + end subroutine amg_c_base_onelev_map_prol_a + subroutine amg_c_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty) + import + implicit none + class(amg_c_onelev_type), target, intent(inout) :: lv + complex(psb_spk_), intent(in) :: alpha, beta + type(psb_c_vect_type), intent(inout) :: vect_u, vect_v + integer(psb_ipk_), intent(out) :: info + complex(psb_spk_), optional :: work(:) + type(psb_c_vect_type), optional, target, intent(inout) :: vtx,vty + end subroutine amg_c_base_onelev_map_prol_v + end interface contains ! @@ -839,94 +886,6 @@ contains end if end function c_wrk_sizeof - subroutine amg_c_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work) - implicit none - class(amg_c_onelev_type), target, intent(inout) :: lv - complex(psb_spk_), intent(in) :: alpha, beta - complex(psb_spk_), intent(inout) :: u(:) - complex(psb_spk_), intent(out) :: v(:) - integer(psb_ipk_), intent(out) :: info - complex(psb_spk_), optional :: work(:) - - if (lv%remap_data%ac_pre_remap%is_asb()) then - ! - ! Remap has happened, deal with it - ! - write(0,*) 'Remap handling not implemented yet ' - else - ! Default transfer - call lv%linmap%map_U2V(alpha,u,beta,v,info,& - & work=work) - end if - - end subroutine amg_c_base_onelev_map_rstr_a - - subroutine amg_c_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work) - implicit none - class(amg_c_onelev_type), target, intent(inout) :: lv - complex(psb_spk_), intent(in) :: alpha, beta - complex(psb_spk_), intent(inout) :: u(:) - complex(psb_spk_), intent(out) :: v(:) - integer(psb_ipk_), intent(out) :: info - complex(psb_spk_), optional :: work(:) - - if (lv%remap_data%ac_pre_remap%is_asb()) then - ! - ! Remap has happened, deal with it - ! - write(0,*) 'Remap handling not implemented yet ' - else - ! Default transfer - call lv%linmap%map_V2U(alpha,v,beta,u,info,& - & work=work) - end if - - end subroutine amg_c_base_onelev_map_prol_a - - subroutine amg_c_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,work,vtx,vty) - implicit none - class(amg_c_onelev_type), target, intent(inout) :: lv - complex(psb_spk_), intent(in) :: alpha, beta - type(psb_c_vect_type), intent(inout) :: vect_u, vect_v - integer(psb_ipk_), intent(out) :: info - complex(psb_spk_), optional :: work(:) - type(psb_c_vect_type), optional, target, intent(inout) :: vtx,vty - - if (lv%remap_data%ac_pre_remap%is_asb()) then - ! - ! Remap has happened, deal with it - ! - write(0,*) 'Remap handling not implemented yet ' - else - ! Default transfer - call lv%linmap%map_U2V(alpha,vect_u,beta,vect_v,info,& - & work=work,vtx=vtx,vty=vty) - end if - - end subroutine amg_c_base_onelev_map_rstr_v - - subroutine amg_c_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty) - implicit none - class(amg_c_onelev_type), target, intent(inout) :: lv - complex(psb_spk_), intent(in) :: alpha, beta - type(psb_c_vect_type), intent(inout) :: vect_u, vect_v - integer(psb_ipk_), intent(out) :: info - complex(psb_spk_), optional :: work(:) - type(psb_c_vect_type), optional, target, intent(inout) :: vtx,vty - - if (lv%remap_data%ac_pre_remap%is_asb()) then - ! - ! Remap has happened, deal with it - ! - write(0,*) 'Remap handling not implemented yet ' - else - ! Default transfer - call lv%linmap%map_V2U(alpha,vect_v,beta,vect_u,info,& - & work=work,vtx=vtx,vty=vty) - end if - - end subroutine amg_c_base_onelev_map_prol_v - subroutine c_remap_data_clone(rmp, remap_out, info) use psb_base_mod implicit none diff --git a/amgprec/amg_d_onelev_mod.f90 b/amgprec/amg_d_onelev_mod.f90 index cfbd5afe..511c3986 100644 --- a/amgprec/amg_d_onelev_mod.f90 +++ b/amgprec/amg_d_onelev_mod.f90 @@ -411,6 +411,53 @@ interface logical, optional, intent(in) :: ac, rp, smoother, solver, tprol, global_num end subroutine amg_d_base_onelev_dump end interface + + interface + subroutine amg_d_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work) + import + implicit none + class(amg_d_onelev_type), target, intent(inout) :: lv + real(psb_dpk_), intent(in) :: alpha, beta + real(psb_dpk_), intent(inout) :: u(:) + real(psb_dpk_), intent(out) :: v(:) + integer(psb_ipk_), intent(out) :: info + real(psb_dpk_), optional :: work(:) + end subroutine amg_d_base_onelev_map_rstr_a + subroutine amg_d_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,work,vtx,vty) + import + implicit none + class(amg_d_onelev_type), target, intent(inout) :: lv + real(psb_dpk_), intent(in) :: alpha, beta + type(psb_d_vect_type), intent(inout) :: vect_u, vect_v + integer(psb_ipk_), intent(out) :: info + real(psb_dpk_), optional :: work(:) + type(psb_d_vect_type), optional, target, intent(inout) :: vtx,vty + end subroutine amg_d_base_onelev_map_rstr_v + end interface + + interface + subroutine amg_d_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work) + import + implicit none + class(amg_d_onelev_type), target, intent(inout) :: lv + real(psb_dpk_), intent(in) :: alpha, beta + real(psb_dpk_), intent(inout) :: u(:) + real(psb_dpk_), intent(out) :: v(:) + integer(psb_ipk_), intent(out) :: info + real(psb_dpk_), optional :: work(:) + + end subroutine amg_d_base_onelev_map_prol_a + subroutine amg_d_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty) + import + implicit none + class(amg_d_onelev_type), target, intent(inout) :: lv + real(psb_dpk_), intent(in) :: alpha, beta + type(psb_d_vect_type), intent(inout) :: vect_u, vect_v + integer(psb_ipk_), intent(out) :: info + real(psb_dpk_), optional :: work(:) + type(psb_d_vect_type), optional, target, intent(inout) :: vtx,vty + end subroutine amg_d_base_onelev_map_prol_v + end interface contains ! @@ -839,94 +886,6 @@ contains end if end function d_wrk_sizeof - subroutine amg_d_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work) - implicit none - class(amg_d_onelev_type), target, intent(inout) :: lv - real(psb_dpk_), intent(in) :: alpha, beta - real(psb_dpk_), intent(inout) :: u(:) - real(psb_dpk_), intent(out) :: v(:) - integer(psb_ipk_), intent(out) :: info - real(psb_dpk_), optional :: work(:) - - if (lv%remap_data%ac_pre_remap%is_asb()) then - ! - ! Remap has happened, deal with it - ! - write(0,*) 'Remap handling not implemented yet ' - else - ! Default transfer - call lv%linmap%map_U2V(alpha,u,beta,v,info,& - & work=work) - end if - - end subroutine amg_d_base_onelev_map_rstr_a - - subroutine amg_d_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work) - implicit none - class(amg_d_onelev_type), target, intent(inout) :: lv - real(psb_dpk_), intent(in) :: alpha, beta - real(psb_dpk_), intent(inout) :: u(:) - real(psb_dpk_), intent(out) :: v(:) - integer(psb_ipk_), intent(out) :: info - real(psb_dpk_), optional :: work(:) - - if (lv%remap_data%ac_pre_remap%is_asb()) then - ! - ! Remap has happened, deal with it - ! - write(0,*) 'Remap handling not implemented yet ' - else - ! Default transfer - call lv%linmap%map_V2U(alpha,v,beta,u,info,& - & work=work) - end if - - end subroutine amg_d_base_onelev_map_prol_a - - subroutine amg_d_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,work,vtx,vty) - implicit none - class(amg_d_onelev_type), target, intent(inout) :: lv - real(psb_dpk_), intent(in) :: alpha, beta - type(psb_d_vect_type), intent(inout) :: vect_u, vect_v - integer(psb_ipk_), intent(out) :: info - real(psb_dpk_), optional :: work(:) - type(psb_d_vect_type), optional, target, intent(inout) :: vtx,vty - - if (lv%remap_data%ac_pre_remap%is_asb()) then - ! - ! Remap has happened, deal with it - ! - write(0,*) 'Remap handling not implemented yet ' - else - ! Default transfer - call lv%linmap%map_U2V(alpha,vect_u,beta,vect_v,info,& - & work=work,vtx=vtx,vty=vty) - end if - - end subroutine amg_d_base_onelev_map_rstr_v - - subroutine amg_d_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty) - implicit none - class(amg_d_onelev_type), target, intent(inout) :: lv - real(psb_dpk_), intent(in) :: alpha, beta - type(psb_d_vect_type), intent(inout) :: vect_u, vect_v - integer(psb_ipk_), intent(out) :: info - real(psb_dpk_), optional :: work(:) - type(psb_d_vect_type), optional, target, intent(inout) :: vtx,vty - - if (lv%remap_data%ac_pre_remap%is_asb()) then - ! - ! Remap has happened, deal with it - ! - write(0,*) 'Remap handling not implemented yet ' - else - ! Default transfer - call lv%linmap%map_V2U(alpha,vect_v,beta,vect_u,info,& - & work=work,vtx=vtx,vty=vty) - end if - - end subroutine amg_d_base_onelev_map_prol_v - subroutine d_remap_data_clone(rmp, remap_out, info) use psb_base_mod implicit none diff --git a/amgprec/amg_s_onelev_mod.f90 b/amgprec/amg_s_onelev_mod.f90 index de5977d2..06d13ef5 100644 --- a/amgprec/amg_s_onelev_mod.f90 +++ b/amgprec/amg_s_onelev_mod.f90 @@ -411,6 +411,53 @@ interface logical, optional, intent(in) :: ac, rp, smoother, solver, tprol, global_num end subroutine amg_s_base_onelev_dump end interface + + interface + subroutine amg_s_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work) + import + implicit none + class(amg_s_onelev_type), target, intent(inout) :: lv + real(psb_spk_), intent(in) :: alpha, beta + real(psb_spk_), intent(inout) :: u(:) + real(psb_spk_), intent(out) :: v(:) + integer(psb_ipk_), intent(out) :: info + real(psb_spk_), optional :: work(:) + end subroutine amg_s_base_onelev_map_rstr_a + subroutine amg_s_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,work,vtx,vty) + import + implicit none + class(amg_s_onelev_type), target, intent(inout) :: lv + real(psb_spk_), intent(in) :: alpha, beta + type(psb_s_vect_type), intent(inout) :: vect_u, vect_v + integer(psb_ipk_), intent(out) :: info + real(psb_spk_), optional :: work(:) + type(psb_s_vect_type), optional, target, intent(inout) :: vtx,vty + end subroutine amg_s_base_onelev_map_rstr_v + end interface + + interface + subroutine amg_s_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work) + import + implicit none + class(amg_s_onelev_type), target, intent(inout) :: lv + real(psb_spk_), intent(in) :: alpha, beta + real(psb_spk_), intent(inout) :: u(:) + real(psb_spk_), intent(out) :: v(:) + integer(psb_ipk_), intent(out) :: info + real(psb_spk_), optional :: work(:) + + end subroutine amg_s_base_onelev_map_prol_a + subroutine amg_s_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty) + import + implicit none + class(amg_s_onelev_type), target, intent(inout) :: lv + real(psb_spk_), intent(in) :: alpha, beta + type(psb_s_vect_type), intent(inout) :: vect_u, vect_v + integer(psb_ipk_), intent(out) :: info + real(psb_spk_), optional :: work(:) + type(psb_s_vect_type), optional, target, intent(inout) :: vtx,vty + end subroutine amg_s_base_onelev_map_prol_v + end interface contains ! @@ -839,94 +886,6 @@ contains end if end function s_wrk_sizeof - subroutine amg_s_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work) - implicit none - class(amg_s_onelev_type), target, intent(inout) :: lv - real(psb_spk_), intent(in) :: alpha, beta - real(psb_spk_), intent(inout) :: u(:) - real(psb_spk_), intent(out) :: v(:) - integer(psb_ipk_), intent(out) :: info - real(psb_spk_), optional :: work(:) - - if (lv%remap_data%ac_pre_remap%is_asb()) then - ! - ! Remap has happened, deal with it - ! - write(0,*) 'Remap handling not implemented yet ' - else - ! Default transfer - call lv%linmap%map_U2V(alpha,u,beta,v,info,& - & work=work) - end if - - end subroutine amg_s_base_onelev_map_rstr_a - - subroutine amg_s_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work) - implicit none - class(amg_s_onelev_type), target, intent(inout) :: lv - real(psb_spk_), intent(in) :: alpha, beta - real(psb_spk_), intent(inout) :: u(:) - real(psb_spk_), intent(out) :: v(:) - integer(psb_ipk_), intent(out) :: info - real(psb_spk_), optional :: work(:) - - if (lv%remap_data%ac_pre_remap%is_asb()) then - ! - ! Remap has happened, deal with it - ! - write(0,*) 'Remap handling not implemented yet ' - else - ! Default transfer - call lv%linmap%map_V2U(alpha,v,beta,u,info,& - & work=work) - end if - - end subroutine amg_s_base_onelev_map_prol_a - - subroutine amg_s_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,work,vtx,vty) - implicit none - class(amg_s_onelev_type), target, intent(inout) :: lv - real(psb_spk_), intent(in) :: alpha, beta - type(psb_s_vect_type), intent(inout) :: vect_u, vect_v - integer(psb_ipk_), intent(out) :: info - real(psb_spk_), optional :: work(:) - type(psb_s_vect_type), optional, target, intent(inout) :: vtx,vty - - if (lv%remap_data%ac_pre_remap%is_asb()) then - ! - ! Remap has happened, deal with it - ! - write(0,*) 'Remap handling not implemented yet ' - else - ! Default transfer - call lv%linmap%map_U2V(alpha,vect_u,beta,vect_v,info,& - & work=work,vtx=vtx,vty=vty) - end if - - end subroutine amg_s_base_onelev_map_rstr_v - - subroutine amg_s_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty) - implicit none - class(amg_s_onelev_type), target, intent(inout) :: lv - real(psb_spk_), intent(in) :: alpha, beta - type(psb_s_vect_type), intent(inout) :: vect_u, vect_v - integer(psb_ipk_), intent(out) :: info - real(psb_spk_), optional :: work(:) - type(psb_s_vect_type), optional, target, intent(inout) :: vtx,vty - - if (lv%remap_data%ac_pre_remap%is_asb()) then - ! - ! Remap has happened, deal with it - ! - write(0,*) 'Remap handling not implemented yet ' - else - ! Default transfer - call lv%linmap%map_V2U(alpha,vect_v,beta,vect_u,info,& - & work=work,vtx=vtx,vty=vty) - end if - - end subroutine amg_s_base_onelev_map_prol_v - subroutine s_remap_data_clone(rmp, remap_out, info) use psb_base_mod implicit none diff --git a/amgprec/amg_z_onelev_mod.f90 b/amgprec/amg_z_onelev_mod.f90 index f4aeb596..6328218c 100644 --- a/amgprec/amg_z_onelev_mod.f90 +++ b/amgprec/amg_z_onelev_mod.f90 @@ -411,6 +411,53 @@ interface logical, optional, intent(in) :: ac, rp, smoother, solver, tprol, global_num end subroutine amg_z_base_onelev_dump end interface + + interface + subroutine amg_z_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work) + import + implicit none + class(amg_z_onelev_type), target, intent(inout) :: lv + complex(psb_dpk_), intent(in) :: alpha, beta + complex(psb_dpk_), intent(inout) :: u(:) + complex(psb_dpk_), intent(out) :: v(:) + integer(psb_ipk_), intent(out) :: info + complex(psb_dpk_), optional :: work(:) + end subroutine amg_z_base_onelev_map_rstr_a + subroutine amg_z_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,work,vtx,vty) + import + implicit none + class(amg_z_onelev_type), target, intent(inout) :: lv + complex(psb_dpk_), intent(in) :: alpha, beta + type(psb_z_vect_type), intent(inout) :: vect_u, vect_v + integer(psb_ipk_), intent(out) :: info + complex(psb_dpk_), optional :: work(:) + type(psb_z_vect_type), optional, target, intent(inout) :: vtx,vty + end subroutine amg_z_base_onelev_map_rstr_v + end interface + + interface + subroutine amg_z_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work) + import + implicit none + class(amg_z_onelev_type), target, intent(inout) :: lv + complex(psb_dpk_), intent(in) :: alpha, beta + complex(psb_dpk_), intent(inout) :: u(:) + complex(psb_dpk_), intent(out) :: v(:) + integer(psb_ipk_), intent(out) :: info + complex(psb_dpk_), optional :: work(:) + + end subroutine amg_z_base_onelev_map_prol_a + subroutine amg_z_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty) + import + implicit none + class(amg_z_onelev_type), target, intent(inout) :: lv + complex(psb_dpk_), intent(in) :: alpha, beta + type(psb_z_vect_type), intent(inout) :: vect_u, vect_v + integer(psb_ipk_), intent(out) :: info + complex(psb_dpk_), optional :: work(:) + type(psb_z_vect_type), optional, target, intent(inout) :: vtx,vty + end subroutine amg_z_base_onelev_map_prol_v + end interface contains ! @@ -839,94 +886,6 @@ contains end if end function z_wrk_sizeof - subroutine amg_z_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work) - implicit none - class(amg_z_onelev_type), target, intent(inout) :: lv - complex(psb_dpk_), intent(in) :: alpha, beta - complex(psb_dpk_), intent(inout) :: u(:) - complex(psb_dpk_), intent(out) :: v(:) - integer(psb_ipk_), intent(out) :: info - complex(psb_dpk_), optional :: work(:) - - if (lv%remap_data%ac_pre_remap%is_asb()) then - ! - ! Remap has happened, deal with it - ! - write(0,*) 'Remap handling not implemented yet ' - else - ! Default transfer - call lv%linmap%map_U2V(alpha,u,beta,v,info,& - & work=work) - end if - - end subroutine amg_z_base_onelev_map_rstr_a - - subroutine amg_z_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work) - implicit none - class(amg_z_onelev_type), target, intent(inout) :: lv - complex(psb_dpk_), intent(in) :: alpha, beta - complex(psb_dpk_), intent(inout) :: u(:) - complex(psb_dpk_), intent(out) :: v(:) - integer(psb_ipk_), intent(out) :: info - complex(psb_dpk_), optional :: work(:) - - if (lv%remap_data%ac_pre_remap%is_asb()) then - ! - ! Remap has happened, deal with it - ! - write(0,*) 'Remap handling not implemented yet ' - else - ! Default transfer - call lv%linmap%map_V2U(alpha,v,beta,u,info,& - & work=work) - end if - - end subroutine amg_z_base_onelev_map_prol_a - - subroutine amg_z_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,work,vtx,vty) - implicit none - class(amg_z_onelev_type), target, intent(inout) :: lv - complex(psb_dpk_), intent(in) :: alpha, beta - type(psb_z_vect_type), intent(inout) :: vect_u, vect_v - integer(psb_ipk_), intent(out) :: info - complex(psb_dpk_), optional :: work(:) - type(psb_z_vect_type), optional, target, intent(inout) :: vtx,vty - - if (lv%remap_data%ac_pre_remap%is_asb()) then - ! - ! Remap has happened, deal with it - ! - write(0,*) 'Remap handling not implemented yet ' - else - ! Default transfer - call lv%linmap%map_U2V(alpha,vect_u,beta,vect_v,info,& - & work=work,vtx=vtx,vty=vty) - end if - - end subroutine amg_z_base_onelev_map_rstr_v - - subroutine amg_z_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty) - implicit none - class(amg_z_onelev_type), target, intent(inout) :: lv - complex(psb_dpk_), intent(in) :: alpha, beta - type(psb_z_vect_type), intent(inout) :: vect_u, vect_v - integer(psb_ipk_), intent(out) :: info - complex(psb_dpk_), optional :: work(:) - type(psb_z_vect_type), optional, target, intent(inout) :: vtx,vty - - if (lv%remap_data%ac_pre_remap%is_asb()) then - ! - ! Remap has happened, deal with it - ! - write(0,*) 'Remap handling not implemented yet ' - else - ! Default transfer - call lv%linmap%map_V2U(alpha,vect_v,beta,vect_u,info,& - & work=work,vtx=vtx,vty=vty) - end if - - end subroutine amg_z_base_onelev_map_prol_v - subroutine z_remap_data_clone(rmp, remap_out, info) use psb_base_mod implicit none diff --git a/amgprec/impl/level/amg_c_base_onelev_map_prol.F90 b/amgprec/impl/level/amg_c_base_onelev_map_prol.F90 new file mode 100644 index 00000000..0ec5dda1 --- /dev/null +++ b/amgprec/impl/level/amg_c_base_onelev_map_prol.F90 @@ -0,0 +1,85 @@ +! +! +! AMG4PSBLAS version 1.0 +! Algebraic Multigrid Package +! based on PSBLAS (Parallel Sparse BLAS version 3.5) +! +! (C) Copyright 2020 +! +! Salvatore Filippone +! Pasqua D'Ambra +! Fabio Durastante +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the AMG4PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS +! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +! POSSIBILITY OF SUCH DAMAGE. +! +! +subroutine amg_c_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty) + use psb_base_mod + use amg_c_onelev_mod, amg_protect_name => amg_c_base_onelev_map_prol_v + + implicit none + class(amg_c_onelev_type), target, intent(inout) :: lv + complex(psb_spk_), intent(in) :: alpha, beta + type(psb_c_vect_type), intent(inout) :: vect_u, vect_v + integer(psb_ipk_), intent(out) :: info + complex(psb_spk_), optional :: work(:) + type(psb_c_vect_type), optional, target, intent(inout) :: vtx,vty + + if (lv%remap_data%ac_pre_remap%is_asb()) then + ! + ! Remap has happened, deal with it + ! + write(0,*) 'Remap handling not implemented yet ' + else + ! Default transfer + call lv%linmap%map_V2U(alpha,vect_v,beta,vect_u,info,& + & work=work,vtx=vtx,vty=vty) + end if + +end subroutine amg_c_base_onelev_map_prol_v + +subroutine amg_c_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work) + use psb_base_mod + use amg_c_onelev_mod, amg_protect_name => amg_c_base_onelev_map_prol_a + implicit none + class(amg_c_onelev_type), target, intent(inout) :: lv + complex(psb_spk_), intent(in) :: alpha, beta + complex(psb_spk_), intent(inout) :: u(:) + complex(psb_spk_), intent(out) :: v(:) + integer(psb_ipk_), intent(out) :: info + complex(psb_spk_), optional :: work(:) + + if (lv%remap_data%ac_pre_remap%is_asb()) then + ! + ! Remap has happened, deal with it + ! + write(0,*) 'Remap handling not implemented yet ' + else + ! Default transfer + call lv%linmap%map_V2U(alpha,v,beta,u,info,& + & work=work) + end if + +end subroutine amg_c_base_onelev_map_prol_a diff --git a/amgprec/impl/level/amg_c_base_onelev_map_rstr.F90 b/amgprec/impl/level/amg_c_base_onelev_map_rstr.F90 new file mode 100644 index 00000000..44a6ffa9 --- /dev/null +++ b/amgprec/impl/level/amg_c_base_onelev_map_rstr.F90 @@ -0,0 +1,85 @@ +! +! +! AMG4PSBLAS version 1.0 +! Algebraic Multigrid Package +! based on PSBLAS (Parallel Sparse BLAS version 3.5) +! +! (C) Copyright 2020 +! +! Salvatore Filippone +! Pasqua D'Ambra +! Fabio Durastante +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the AMG4PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS +! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +! POSSIBILITY OF SUCH DAMAGE. +! +! + +subroutine amg_c_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,work,vtx,vty) + use psb_base_mod + use amg_c_onelev_mod, amg_protect_name => amg_c_base_onelev_map_rstr_v + implicit none + class(amg_c_onelev_type), target, intent(inout) :: lv + complex(psb_spk_), intent(in) :: alpha, beta + type(psb_c_vect_type), intent(inout) :: vect_u, vect_v + integer(psb_ipk_), intent(out) :: info + complex(psb_spk_), optional :: work(:) + type(psb_c_vect_type), optional, target, intent(inout) :: vtx,vty + + if (lv%remap_data%ac_pre_remap%is_asb()) then + ! + ! Remap has happened, deal with it + ! + write(0,*) 'Remap handling not implemented yet ' + else + ! Default transfer + call lv%linmap%map_U2V(alpha,vect_u,beta,vect_v,info,& + & work=work,vtx=vtx,vty=vty) + end if + +end subroutine amg_c_base_onelev_map_rstr_v + +subroutine amg_c_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work) + use psb_base_mod + use amg_c_onelev_mod, amg_protect_name => amg_c_base_onelev_map_rstr_a + implicit none + class(amg_c_onelev_type), target, intent(inout) :: lv + complex(psb_spk_), intent(in) :: alpha, beta + complex(psb_spk_), intent(inout) :: u(:) + complex(psb_spk_), intent(out) :: v(:) + integer(psb_ipk_), intent(out) :: info + complex(psb_spk_), optional :: work(:) + + if (lv%remap_data%ac_pre_remap%is_asb()) then + ! + ! Remap has happened, deal with it + ! + write(0,*) 'Remap handling not implemented yet ' + else + ! Default transfer + call lv%linmap%map_U2V(alpha,u,beta,v,info,& + & work=work) + end if + +end subroutine amg_c_base_onelev_map_rstr_a diff --git a/amgprec/impl/level/amg_d_base_onelev_map_prol.F90 b/amgprec/impl/level/amg_d_base_onelev_map_prol.F90 new file mode 100644 index 00000000..4d7e27e0 --- /dev/null +++ b/amgprec/impl/level/amg_d_base_onelev_map_prol.F90 @@ -0,0 +1,85 @@ +! +! +! AMG4PSBLAS version 1.0 +! Algebraic Multigrid Package +! based on PSBLAS (Parallel Sparse BLAS version 3.5) +! +! (C) Copyright 2020 +! +! Salvatore Filippone +! Pasqua D'Ambra +! Fabio Durastante +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the AMG4PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS +! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +! POSSIBILITY OF SUCH DAMAGE. +! +! +subroutine amg_d_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty) + use psb_base_mod + use amg_d_onelev_mod, amg_protect_name => amg_d_base_onelev_map_prol_v + + implicit none + class(amg_d_onelev_type), target, intent(inout) :: lv + real(psb_dpk_), intent(in) :: alpha, beta + type(psb_d_vect_type), intent(inout) :: vect_u, vect_v + integer(psb_ipk_), intent(out) :: info + real(psb_dpk_), optional :: work(:) + type(psb_d_vect_type), optional, target, intent(inout) :: vtx,vty + + if (lv%remap_data%ac_pre_remap%is_asb()) then + ! + ! Remap has happened, deal with it + ! + write(0,*) 'Remap handling not implemented yet ' + else + ! Default transfer + call lv%linmap%map_V2U(alpha,vect_v,beta,vect_u,info,& + & work=work,vtx=vtx,vty=vty) + end if + +end subroutine amg_d_base_onelev_map_prol_v + +subroutine amg_d_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work) + use psb_base_mod + use amg_d_onelev_mod, amg_protect_name => amg_d_base_onelev_map_prol_a + implicit none + class(amg_d_onelev_type), target, intent(inout) :: lv + real(psb_dpk_), intent(in) :: alpha, beta + real(psb_dpk_), intent(inout) :: u(:) + real(psb_dpk_), intent(out) :: v(:) + integer(psb_ipk_), intent(out) :: info + real(psb_dpk_), optional :: work(:) + + if (lv%remap_data%ac_pre_remap%is_asb()) then + ! + ! Remap has happened, deal with it + ! + write(0,*) 'Remap handling not implemented yet ' + else + ! Default transfer + call lv%linmap%map_V2U(alpha,v,beta,u,info,& + & work=work) + end if + +end subroutine amg_d_base_onelev_map_prol_a diff --git a/amgprec/impl/level/amg_d_base_onelev_map_rstr.F90 b/amgprec/impl/level/amg_d_base_onelev_map_rstr.F90 new file mode 100644 index 00000000..58353cab --- /dev/null +++ b/amgprec/impl/level/amg_d_base_onelev_map_rstr.F90 @@ -0,0 +1,85 @@ +! +! +! AMG4PSBLAS version 1.0 +! Algebraic Multigrid Package +! based on PSBLAS (Parallel Sparse BLAS version 3.5) +! +! (C) Copyright 2020 +! +! Salvatore Filippone +! Pasqua D'Ambra +! Fabio Durastante +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the AMG4PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS +! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +! POSSIBILITY OF SUCH DAMAGE. +! +! + +subroutine amg_d_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,work,vtx,vty) + use psb_base_mod + use amg_d_onelev_mod, amg_protect_name => amg_d_base_onelev_map_rstr_v + implicit none + class(amg_d_onelev_type), target, intent(inout) :: lv + real(psb_dpk_), intent(in) :: alpha, beta + type(psb_d_vect_type), intent(inout) :: vect_u, vect_v + integer(psb_ipk_), intent(out) :: info + real(psb_dpk_), optional :: work(:) + type(psb_d_vect_type), optional, target, intent(inout) :: vtx,vty + + if (lv%remap_data%ac_pre_remap%is_asb()) then + ! + ! Remap has happened, deal with it + ! + write(0,*) 'Remap handling not implemented yet ' + else + ! Default transfer + call lv%linmap%map_U2V(alpha,vect_u,beta,vect_v,info,& + & work=work,vtx=vtx,vty=vty) + end if + +end subroutine amg_d_base_onelev_map_rstr_v + +subroutine amg_d_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work) + use psb_base_mod + use amg_d_onelev_mod, amg_protect_name => amg_d_base_onelev_map_rstr_a + implicit none + class(amg_d_onelev_type), target, intent(inout) :: lv + real(psb_dpk_), intent(in) :: alpha, beta + real(psb_dpk_), intent(inout) :: u(:) + real(psb_dpk_), intent(out) :: v(:) + integer(psb_ipk_), intent(out) :: info + real(psb_dpk_), optional :: work(:) + + if (lv%remap_data%ac_pre_remap%is_asb()) then + ! + ! Remap has happened, deal with it + ! + write(0,*) 'Remap handling not implemented yet ' + else + ! Default transfer + call lv%linmap%map_U2V(alpha,u,beta,v,info,& + & work=work) + end if + +end subroutine amg_d_base_onelev_map_rstr_a diff --git a/amgprec/impl/level/amg_s_base_onelev_map_prol.F90 b/amgprec/impl/level/amg_s_base_onelev_map_prol.F90 new file mode 100644 index 00000000..1b1777b4 --- /dev/null +++ b/amgprec/impl/level/amg_s_base_onelev_map_prol.F90 @@ -0,0 +1,85 @@ +! +! +! AMG4PSBLAS version 1.0 +! Algebraic Multigrid Package +! based on PSBLAS (Parallel Sparse BLAS version 3.5) +! +! (C) Copyright 2020 +! +! Salvatore Filippone +! Pasqua D'Ambra +! Fabio Durastante +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the AMG4PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS +! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +! POSSIBILITY OF SUCH DAMAGE. +! +! +subroutine amg_s_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty) + use psb_base_mod + use amg_s_onelev_mod, amg_protect_name => amg_s_base_onelev_map_prol_v + + implicit none + class(amg_s_onelev_type), target, intent(inout) :: lv + real(psb_spk_), intent(in) :: alpha, beta + type(psb_s_vect_type), intent(inout) :: vect_u, vect_v + integer(psb_ipk_), intent(out) :: info + real(psb_spk_), optional :: work(:) + type(psb_s_vect_type), optional, target, intent(inout) :: vtx,vty + + if (lv%remap_data%ac_pre_remap%is_asb()) then + ! + ! Remap has happened, deal with it + ! + write(0,*) 'Remap handling not implemented yet ' + else + ! Default transfer + call lv%linmap%map_V2U(alpha,vect_v,beta,vect_u,info,& + & work=work,vtx=vtx,vty=vty) + end if + +end subroutine amg_s_base_onelev_map_prol_v + +subroutine amg_s_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work) + use psb_base_mod + use amg_s_onelev_mod, amg_protect_name => amg_s_base_onelev_map_prol_a + implicit none + class(amg_s_onelev_type), target, intent(inout) :: lv + real(psb_spk_), intent(in) :: alpha, beta + real(psb_spk_), intent(inout) :: u(:) + real(psb_spk_), intent(out) :: v(:) + integer(psb_ipk_), intent(out) :: info + real(psb_spk_), optional :: work(:) + + if (lv%remap_data%ac_pre_remap%is_asb()) then + ! + ! Remap has happened, deal with it + ! + write(0,*) 'Remap handling not implemented yet ' + else + ! Default transfer + call lv%linmap%map_V2U(alpha,v,beta,u,info,& + & work=work) + end if + +end subroutine amg_s_base_onelev_map_prol_a diff --git a/amgprec/impl/level/amg_s_base_onelev_map_rstr.F90 b/amgprec/impl/level/amg_s_base_onelev_map_rstr.F90 new file mode 100644 index 00000000..d19b2924 --- /dev/null +++ b/amgprec/impl/level/amg_s_base_onelev_map_rstr.F90 @@ -0,0 +1,85 @@ +! +! +! AMG4PSBLAS version 1.0 +! Algebraic Multigrid Package +! based on PSBLAS (Parallel Sparse BLAS version 3.5) +! +! (C) Copyright 2020 +! +! Salvatore Filippone +! Pasqua D'Ambra +! Fabio Durastante +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the AMG4PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS +! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +! POSSIBILITY OF SUCH DAMAGE. +! +! + +subroutine amg_s_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,work,vtx,vty) + use psb_base_mod + use amg_s_onelev_mod, amg_protect_name => amg_s_base_onelev_map_rstr_v + implicit none + class(amg_s_onelev_type), target, intent(inout) :: lv + real(psb_spk_), intent(in) :: alpha, beta + type(psb_s_vect_type), intent(inout) :: vect_u, vect_v + integer(psb_ipk_), intent(out) :: info + real(psb_spk_), optional :: work(:) + type(psb_s_vect_type), optional, target, intent(inout) :: vtx,vty + + if (lv%remap_data%ac_pre_remap%is_asb()) then + ! + ! Remap has happened, deal with it + ! + write(0,*) 'Remap handling not implemented yet ' + else + ! Default transfer + call lv%linmap%map_U2V(alpha,vect_u,beta,vect_v,info,& + & work=work,vtx=vtx,vty=vty) + end if + +end subroutine amg_s_base_onelev_map_rstr_v + +subroutine amg_s_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work) + use psb_base_mod + use amg_s_onelev_mod, amg_protect_name => amg_s_base_onelev_map_rstr_a + implicit none + class(amg_s_onelev_type), target, intent(inout) :: lv + real(psb_spk_), intent(in) :: alpha, beta + real(psb_spk_), intent(inout) :: u(:) + real(psb_spk_), intent(out) :: v(:) + integer(psb_ipk_), intent(out) :: info + real(psb_spk_), optional :: work(:) + + if (lv%remap_data%ac_pre_remap%is_asb()) then + ! + ! Remap has happened, deal with it + ! + write(0,*) 'Remap handling not implemented yet ' + else + ! Default transfer + call lv%linmap%map_U2V(alpha,u,beta,v,info,& + & work=work) + end if + +end subroutine amg_s_base_onelev_map_rstr_a diff --git a/amgprec/impl/level/amg_z_base_onelev_map_prol.F90 b/amgprec/impl/level/amg_z_base_onelev_map_prol.F90 new file mode 100644 index 00000000..16c982cc --- /dev/null +++ b/amgprec/impl/level/amg_z_base_onelev_map_prol.F90 @@ -0,0 +1,85 @@ +! +! +! AMG4PSBLAS version 1.0 +! Algebraic Multigrid Package +! based on PSBLAS (Parallel Sparse BLAS version 3.5) +! +! (C) Copyright 2020 +! +! Salvatore Filippone +! Pasqua D'Ambra +! Fabio Durastante +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the AMG4PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS +! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +! POSSIBILITY OF SUCH DAMAGE. +! +! +subroutine amg_z_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty) + use psb_base_mod + use amg_z_onelev_mod, amg_protect_name => amg_z_base_onelev_map_prol_v + + implicit none + class(amg_z_onelev_type), target, intent(inout) :: lv + complex(psb_dpk_), intent(in) :: alpha, beta + type(psb_z_vect_type), intent(inout) :: vect_u, vect_v + integer(psb_ipk_), intent(out) :: info + complex(psb_dpk_), optional :: work(:) + type(psb_z_vect_type), optional, target, intent(inout) :: vtx,vty + + if (lv%remap_data%ac_pre_remap%is_asb()) then + ! + ! Remap has happened, deal with it + ! + write(0,*) 'Remap handling not implemented yet ' + else + ! Default transfer + call lv%linmap%map_V2U(alpha,vect_v,beta,vect_u,info,& + & work=work,vtx=vtx,vty=vty) + end if + +end subroutine amg_z_base_onelev_map_prol_v + +subroutine amg_z_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work) + use psb_base_mod + use amg_z_onelev_mod, amg_protect_name => amg_z_base_onelev_map_prol_a + implicit none + class(amg_z_onelev_type), target, intent(inout) :: lv + complex(psb_dpk_), intent(in) :: alpha, beta + complex(psb_dpk_), intent(inout) :: u(:) + complex(psb_dpk_), intent(out) :: v(:) + integer(psb_ipk_), intent(out) :: info + complex(psb_dpk_), optional :: work(:) + + if (lv%remap_data%ac_pre_remap%is_asb()) then + ! + ! Remap has happened, deal with it + ! + write(0,*) 'Remap handling not implemented yet ' + else + ! Default transfer + call lv%linmap%map_V2U(alpha,v,beta,u,info,& + & work=work) + end if + +end subroutine amg_z_base_onelev_map_prol_a diff --git a/amgprec/impl/level/amg_z_base_onelev_map_rstr.F90 b/amgprec/impl/level/amg_z_base_onelev_map_rstr.F90 new file mode 100644 index 00000000..60b9d46c --- /dev/null +++ b/amgprec/impl/level/amg_z_base_onelev_map_rstr.F90 @@ -0,0 +1,85 @@ +! +! +! AMG4PSBLAS version 1.0 +! Algebraic Multigrid Package +! based on PSBLAS (Parallel Sparse BLAS version 3.5) +! +! (C) Copyright 2020 +! +! Salvatore Filippone +! Pasqua D'Ambra +! Fabio Durastante +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the AMG4PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS +! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +! POSSIBILITY OF SUCH DAMAGE. +! +! + +subroutine amg_z_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,work,vtx,vty) + use psb_base_mod + use amg_z_onelev_mod, amg_protect_name => amg_z_base_onelev_map_rstr_v + implicit none + class(amg_z_onelev_type), target, intent(inout) :: lv + complex(psb_dpk_), intent(in) :: alpha, beta + type(psb_z_vect_type), intent(inout) :: vect_u, vect_v + integer(psb_ipk_), intent(out) :: info + complex(psb_dpk_), optional :: work(:) + type(psb_z_vect_type), optional, target, intent(inout) :: vtx,vty + + if (lv%remap_data%ac_pre_remap%is_asb()) then + ! + ! Remap has happened, deal with it + ! + write(0,*) 'Remap handling not implemented yet ' + else + ! Default transfer + call lv%linmap%map_U2V(alpha,vect_u,beta,vect_v,info,& + & work=work,vtx=vtx,vty=vty) + end if + +end subroutine amg_z_base_onelev_map_rstr_v + +subroutine amg_z_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work) + use psb_base_mod + use amg_z_onelev_mod, amg_protect_name => amg_z_base_onelev_map_rstr_a + implicit none + class(amg_z_onelev_type), target, intent(inout) :: lv + complex(psb_dpk_), intent(in) :: alpha, beta + complex(psb_dpk_), intent(inout) :: u(:) + complex(psb_dpk_), intent(out) :: v(:) + integer(psb_ipk_), intent(out) :: info + complex(psb_dpk_), optional :: work(:) + + if (lv%remap_data%ac_pre_remap%is_asb()) then + ! + ! Remap has happened, deal with it + ! + write(0,*) 'Remap handling not implemented yet ' + else + ! Default transfer + call lv%linmap%map_U2V(alpha,u,beta,v,info,& + & work=work) + end if + +end subroutine amg_z_base_onelev_map_rstr_a