From f736089c0d47485303da7ca7b8b2dd7babad244d Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Wed, 24 Mar 2010 09:35:29 +0000 Subject: [PATCH] psblas3: base/modules/Makefile base/modules/psb_base_tools_mod.f90 base/modules/psb_c_tools_mod.f90 base/modules/psb_d_tools_mod.f90 base/modules/psb_linmap_mod.f90 base/modules/psb_s_tools_mod.f90 base/modules/psb_z_tools_mod.f90 base/tools/Makefile configure.ac Various internal splits and fixes due to XLF testing. --- base/modules/Makefile | 6 +- base/modules/psb_base_tools_mod.f90 | 560 ++++++++-------- base/modules/psb_c_tools_mod.f90 | 200 +++--- base/modules/psb_d_tools_mod.f90 | 200 +++--- base/modules/psb_linmap_mod.f90 | 961 ++++++++++++++++------------ base/modules/psb_s_tools_mod.f90 | 200 +++--- base/modules/psb_z_tools_mod.f90 | 202 +++--- base/tools/Makefile | 3 +- configure.ac | 65 +- 9 files changed, 1287 insertions(+), 1110 deletions(-) diff --git a/base/modules/Makefile b/base/modules/Makefile index d6aaea52..5b2a2a36 100644 --- a/base/modules/Makefile +++ b/base/modules/Makefile @@ -7,11 +7,11 @@ UTIL_MODS = psb_string_mod.o \ psb_base_tools_mod.o psb_s_tools_mod.o psb_d_tools_mod.o\ psb_c_tools_mod.o psb_z_tools_mod.o psb_tools_mod.o \ psb_blacs_mod.o \ - psb_linmap_type_mod.o psb_comm_mod.o\ + psb_linmap_type_mod.o psb_linmap_mod.o psb_comm_mod.o\ psb_s_psblas_mod.o psb_c_psblas_mod.o \ psb_d_psblas_mod.o psb_z_psblas_mod.o psb_psblas_mod.o \ psi_serial_mod.o psi_mod.o psb_ip_reord_mod.o\ - psb_check_mod.o psb_gps_mod.o psb_linmap_mod.o psb_hash_mod.o\ + psb_check_mod.o psb_gps_mod.o psb_hash_mod.o\ psb_base_mat_mod.o psb_mat_mod.o\ psb_s_base_mat_mod.o psb_s_csr_mat_mod.o psb_s_csc_mat_mod.o psb_s_mat_mod.o \ psb_d_base_mat_mod.o psb_d_csr_mat_mod.o psb_d_csc_mat_mod.o psb_d_mat_mod.o \ @@ -64,7 +64,7 @@ psb_serial_mod.o: psb_mat_mod.o psb_string_mod.o psb_sort_mod.o psi_serial_mod.o psb_sort_mod.o: psb_error_mod.o psb_realloc_mod.o psb_const_mod.o psb_tools_mod.o: psb_base_tools_mod.o psb_s_tools_mod.o psb_d_tools_mod.o\ psb_c_tools_mod.o psb_z_tools_mod.o -psb_base_tools_mod.o psb_s_tools_mod.o psb_d_tools_mod.o psb_c_tools_mod.o psb_z_tools_mod.o: psb_desc_type.o psi_mod.o psb_gps_mod.o psb_linmap_mod.o psb_mat_mod.o +psb_base_tools_mod.o psb_s_tools_mod.o psb_d_tools_mod.o psb_c_tools_mod.o psb_z_tools_mod.o: psb_desc_type.o psi_mod.o psb_gps_mod.o psb_mat_mod.o psb_psblas_mod.o: psb_mat_mod.o psb_desc_type.o psb_s_psblas_mod.o psb_c_psblas_mod.o \ psb_d_psblas_mod.o psb_z_psblas_mod.o diff --git a/base/modules/psb_base_tools_mod.f90 b/base/modules/psb_base_tools_mod.f90 index 8ad889fb..c8b249be 100644 --- a/base/modules/psb_base_tools_mod.f90 +++ b/base/modules/psb_base_tools_mod.f90 @@ -29,51 +29,10 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -Module psb_base_tools_mod +module psb_iv_tools_mod use psb_const_mod - interface psb_cd_set_bld - subroutine psb_cd_set_bld(desc,info) - use psb_descriptor_type - type(psb_desc_type), intent(inout) :: desc - integer :: info - end subroutine psb_cd_set_bld - end interface - - interface psb_cd_set_ovl_bld - subroutine psb_cd_set_ovl_bld(desc,info) - use psb_descriptor_type - type(psb_desc_type), intent(inout) :: desc - integer :: info - end subroutine psb_cd_set_ovl_bld - end interface - - interface psb_cd_reinit - Subroutine psb_cd_reinit(desc,info) - use psb_descriptor_type - Implicit None - - ! .. Array Arguments .. - Type(psb_desc_type), Intent(inout) :: desc - integer, intent(out) :: info - end Subroutine psb_cd_reinit - end interface - - interface psb_cdcpy - subroutine psb_cdcpy(desc_in, desc_out, info) - use psb_descriptor_type - - implicit none - !....parameters... - - type(psb_desc_type), intent(in) :: desc_in - type(psb_desc_type), intent(out) :: desc_out - integer, intent(out) :: info - end subroutine psb_cdcpy - end interface - - interface psb_geall subroutine psb_ialloc(x, desc_a, info,n, lb) use psb_descriptor_type @@ -107,17 +66,6 @@ Module psb_base_tools_mod end subroutine psb_iasbv end interface - interface psb_cdprt - subroutine psb_cdprt(iout,desc_p,glob,short) - use psb_const_mod - use psb_descriptor_type - implicit none - type(psb_desc_type), intent(in) :: desc_p - integer, intent(in) :: iout - logical, intent(in), optional :: glob,short - end subroutine psb_cdprt - end interface - interface psb_gefree subroutine psb_ifree(x, desc_a, info) @@ -158,57 +106,6 @@ Module psb_base_tools_mod end interface - interface psb_cdall - module procedure psb_cdall - end interface - - interface psb_cdasb - module procedure psb_cdasb - end interface - - interface psb_cdins - subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla) - use psb_descriptor_type - type(psb_desc_type), intent(inout) :: desc_a - integer, intent(in) :: nz,ia(:),ja(:) - integer, intent(out) :: info - integer, optional, intent(out) :: ila(:), jla(:) - end subroutine psb_cdinsrc - subroutine psb_cdinsc(nz,ja,desc,info,jla,mask) - use psb_descriptor_type - type(psb_desc_type), intent(inout) :: desc - integer, intent(in) :: nz,ja(:) - integer, intent(out) :: info - integer, optional, intent(out) :: jla(:) - logical, optional, target, intent(in) :: mask(:) - end subroutine psb_cdinsc - end interface - - interface psb_cdbldext - Subroutine psb_cd_lstext(desc_a,in_list,desc_ov,info, mask,extype) - use psb_descriptor_type - Implicit None - Type(psb_desc_type), Intent(in), target :: desc_a - integer, intent(in) :: in_list(:) - Type(psb_desc_type), Intent(out) :: desc_ov - integer, intent(out) :: info - logical, intent(in), optional, target :: mask(:) - integer, intent(in),optional :: extype - end Subroutine psb_cd_lstext - end interface - - - interface psb_cdren - subroutine psb_cdren(trans,iperm,desc_a,info) - use psb_descriptor_type - type(psb_desc_type), intent(inout) :: desc_a - integer, intent(inout) :: iperm(:) - character, intent(in) :: trans - integer, intent(out) :: info - end subroutine psb_cdren - end interface - - interface psb_glob_to_loc subroutine psb_glob_to_loc2(x,y,desc_a,info,iact,owned) use psb_descriptor_type @@ -286,28 +183,6 @@ Module psb_base_tools_mod end interface - interface psb_get_boundary - module procedure psb_get_boundary - end interface - - interface psb_get_overlap - subroutine psb_get_ovrlap(ovrel,desc,info) - use psb_descriptor_type - implicit none - integer, allocatable, intent(out) :: ovrel(:) - type(psb_desc_type), intent(in) :: desc - integer, intent(out) :: info - end subroutine psb_get_ovrlap - end interface - - interface psb_icdasb - subroutine psb_icdasb(desc,info,ext_hv) - use psb_descriptor_type - Type(psb_desc_type), intent(inout) :: desc - integer, intent(out) :: info - logical, intent(in),optional :: ext_hv - end subroutine psb_icdasb - end interface interface psb_is_owned module procedure psb_is_owned @@ -419,9 +294,164 @@ contains res = (lx>0) end subroutine psb_local_index_v +end module psb_iv_tools_mod + +module psb_cd_if_tools_mod + + use psb_const_mod + + + interface psb_cd_set_bld + subroutine psb_cd_set_bld(desc,info) + use psb_descriptor_type + type(psb_desc_type), intent(inout) :: desc + integer :: info + end subroutine psb_cd_set_bld + end interface + + interface psb_cd_set_ovl_bld + subroutine psb_cd_set_ovl_bld(desc,info) + use psb_descriptor_type + type(psb_desc_type), intent(inout) :: desc + integer :: info + end subroutine psb_cd_set_ovl_bld + end interface + + interface psb_cd_reinit + Subroutine psb_cd_reinit(desc,info) + use psb_descriptor_type + Implicit None + + ! .. Array Arguments .. + Type(psb_desc_type), Intent(inout) :: desc + integer, intent(out) :: info + end Subroutine psb_cd_reinit + end interface + + interface psb_cdcpy + subroutine psb_cdcpy(desc_in, desc_out, info) + use psb_descriptor_type + + implicit none + !....parameters... + + type(psb_desc_type), intent(in) :: desc_in + type(psb_desc_type), intent(out) :: desc_out + integer, intent(out) :: info + end subroutine psb_cdcpy + end interface + + + interface psb_cdprt + subroutine psb_cdprt(iout,desc_p,glob,short) + use psb_const_mod + use psb_descriptor_type + implicit none + type(psb_desc_type), intent(in) :: desc_p + integer, intent(in) :: iout + logical, intent(in), optional :: glob,short + end subroutine psb_cdprt + end interface + + interface psb_cdins + subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla) + use psb_descriptor_type + type(psb_desc_type), intent(inout) :: desc_a + integer, intent(in) :: nz,ia(:),ja(:) + integer, intent(out) :: info + integer, optional, intent(out) :: ila(:), jla(:) + end subroutine psb_cdinsrc + subroutine psb_cdinsc(nz,ja,desc,info,jla,mask) + use psb_descriptor_type + type(psb_desc_type), intent(inout) :: desc + integer, intent(in) :: nz,ja(:) + integer, intent(out) :: info + integer, optional, intent(out) :: jla(:) + logical, optional, target, intent(in) :: mask(:) + end subroutine psb_cdinsc + end interface + + interface psb_cdbldext + Subroutine psb_cd_lstext(desc_a,in_list,desc_ov,info, mask,extype) + use psb_descriptor_type + Implicit None + Type(psb_desc_type), Intent(in), target :: desc_a + integer, intent(in) :: in_list(:) + Type(psb_desc_type), Intent(out) :: desc_ov + integer, intent(out) :: info + logical, intent(in), optional, target :: mask(:) + integer, intent(in),optional :: extype + end Subroutine psb_cd_lstext + end interface + + + interface psb_cdren + subroutine psb_cdren(trans,iperm,desc_a,info) + use psb_descriptor_type + type(psb_desc_type), intent(inout) :: desc_a + integer, intent(inout) :: iperm(:) + character, intent(in) :: trans + integer, intent(out) :: info + end subroutine psb_cdren + end interface + + interface psb_get_overlap + subroutine psb_get_ovrlap(ovrel,desc,info) + use psb_descriptor_type + implicit none + integer, allocatable, intent(out) :: ovrel(:) + type(psb_desc_type), intent(in) :: desc + integer, intent(out) :: info + end subroutine psb_get_ovrlap + end interface + + interface psb_icdasb + subroutine psb_icdasb(desc,info,ext_hv) + use psb_descriptor_type + Type(psb_desc_type), intent(inout) :: desc + integer, intent(out) :: info + logical, intent(in),optional :: ext_hv + end subroutine psb_icdasb + end interface + +end module psb_cd_if_tools_mod + +module psb_cd_tools_mod + + use psb_const_mod + use psb_cd_if_tools_mod + + interface psb_cdall + + subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl, globalcheck) + use psb_descriptor_type + implicit None + include 'parts.fh' + Integer, intent(in) :: mg,ng,ictxt, vg(:), vl(:),nl + integer, intent(in) :: flag + logical, intent(in) :: repl, globalcheck + integer, intent(out) :: info + type(psb_desc_type), intent(out) :: desc + + optional :: mg,ng,parts,vg,vl,flag,nl,repl, globalcheck + end subroutine psb_cdall + + end interface + + interface psb_cdasb + module procedure psb_cdasb + end interface + + interface psb_get_boundary + module procedure psb_get_boundary + end interface + + +contains + subroutine psb_get_boundary(bndel,desc,info) use psb_descriptor_type - use psi_mod + use psi_mod, only : psi_crea_bnd_elem implicit none integer, allocatable, intent(out) :: bndel(:) type(psb_desc_type), intent(in) :: desc @@ -431,153 +461,161 @@ contains end subroutine psb_get_boundary - subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl, globalcheck) + subroutine psb_cdasb(desc,info) use psb_descriptor_type - use psb_serial_mod - use psb_const_mod - use psb_error_mod - use psb_penv_mod - implicit None - include 'parts.fh' - Integer, intent(in) :: mg,ng,ictxt, vg(:), vl(:),nl - integer, intent(in) :: flag - logical, intent(in) :: repl, globalcheck - integer, intent(out) :: info - type(psb_desc_type), intent(out) :: desc - - optional :: mg,ng,parts,vg,vl,flag,nl,repl, globalcheck - - interface - subroutine psb_cdals(m, n, parts, ictxt, desc, info) - use psb_descriptor_type - include 'parts.fh' - Integer, intent(in) :: m,n,ictxt - Type(psb_desc_type), intent(out) :: desc - integer, intent(out) :: info - end subroutine psb_cdals - subroutine psb_cdalv(v, ictxt, desc, info, flag) - use psb_descriptor_type - Integer, intent(in) :: ictxt, v(:) - integer, intent(in), optional :: flag - integer, intent(out) :: info - Type(psb_desc_type), intent(out) :: desc - end subroutine psb_cdalv - subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck) - use psb_descriptor_type - implicit None - Integer, intent(in) :: ictxt, v(:) - integer, intent(out) :: info - type(psb_desc_type), intent(out) :: desc - logical, intent(in), optional :: globalcheck - end subroutine psb_cd_inloc - subroutine psb_cdrep(m, ictxt, desc,info) - use psb_descriptor_type - Integer, intent(in) :: m,ictxt - Type(psb_desc_type), intent(out) :: desc - integer, intent(out) :: info - end subroutine psb_cdrep - end interface - character(len=20) :: name - integer :: err_act, n_, flag_, i, me, np, nlp - integer, allocatable :: itmpsz(:) - - - - if (psb_get_errstatus() /= 0) return - info=0 - name = 'psb_cdall' - call psb_erractionsave(err_act) - - call psb_info(ictxt, me, np) - - if (count((/ present(vg),present(vl),& - & present(parts),present(nl), present(repl) /)) /= 1) then + + Type(psb_desc_type), intent(inout) :: desc + integer, intent(out) :: info + + call psb_icdasb(desc,info,ext_hv=.false.) + end subroutine psb_cdasb + +end module psb_cd_tools_mod + + +module psb_base_tools_mod + use psb_iv_tools_mod + use psb_cd_tools_mod + +end module psb_base_tools_mod + + +subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl, globalcheck) + use psb_descriptor_type + use psb_serial_mod + use psb_const_mod + use psb_error_mod + use psb_penv_mod + implicit None + include 'parts.fh' + Integer, intent(in) :: mg,ng,ictxt, vg(:), vl(:),nl + integer, intent(in) :: flag + logical, intent(in) :: repl, globalcheck + integer, intent(out) :: info + type(psb_desc_type), intent(out) :: desc + + optional :: mg,ng,parts,vg,vl,flag,nl,repl, globalcheck + + interface + subroutine psb_cdals(m, n, parts, ictxt, desc, info) + use psb_descriptor_type + include 'parts.fh' + Integer, intent(in) :: m,n,ictxt + Type(psb_desc_type), intent(out) :: desc + integer, intent(out) :: info + end subroutine psb_cdals + subroutine psb_cdalv(v, ictxt, desc, info, flag) + use psb_descriptor_type + Integer, intent(in) :: ictxt, v(:) + integer, intent(in), optional :: flag + integer, intent(out) :: info + Type(psb_desc_type), intent(out) :: desc + end subroutine psb_cdalv + subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck) + use psb_descriptor_type + implicit None + Integer, intent(in) :: ictxt, v(:) + integer, intent(out) :: info + type(psb_desc_type), intent(out) :: desc + logical, intent(in), optional :: globalcheck + end subroutine psb_cd_inloc + subroutine psb_cdrep(m, ictxt, desc,info) + use psb_descriptor_type + Integer, intent(in) :: m,ictxt + Type(psb_desc_type), intent(out) :: desc + integer, intent(out) :: info + end subroutine psb_cdrep + end interface + character(len=20) :: name + integer :: err_act, n_, flag_, i, me, np, nlp + integer, allocatable :: itmpsz(:) + + + + if (psb_get_errstatus() /= 0) return + info=0 + name = 'psb_cdall' + call psb_erractionsave(err_act) + + call psb_info(ictxt, me, np) + + if (count((/ present(vg),present(vl),& + & present(parts),present(nl), present(repl) /)) /= 1) then + info=581 + call psb_errpush(info,name,a_err=" vg, vl, parts, nl, repl") + goto 999 + endif + + desc%base_desc => null() + + if (present(parts)) then + if (.not.present(mg)) then info=581 - call psb_errpush(info,name,a_err=" vg, vl, parts, nl, repl") + call psb_errpush(info,name) goto 999 + end if + if (present(ng)) then + n_ = ng + else + n_ = mg endif + call psb_cdals(mg, n_, parts, ictxt, desc, info) - desc%base_desc => null() - - if (present(parts)) then - if (.not.present(mg)) then - info=581 - call psb_errpush(info,name) - goto 999 - end if - if (present(ng)) then - n_ = ng - else - n_ = mg - endif - call psb_cdals(mg, n_, parts, ictxt, desc, info) - - else if (present(repl)) then - if (.not.present(mg)) then - info=581 - call psb_errpush(info,name) - goto 999 - end if - if (.not.repl) then - info=581 - call psb_errpush(info,name) - goto 999 - end if - call psb_cdrep(mg, ictxt, desc, info) - - else if (present(vg)) then - if (present(flag)) then - flag_=flag - else - flag_=0 - endif - call psb_cdalv(vg, ictxt, desc, info, flag=flag_) - - else if (present(vl)) then - call psb_cd_inloc(vl,ictxt,desc,info, globalcheck=globalcheck) - - else if (present(nl)) then - allocate(itmpsz(0:np-1),stat=info) - if (info /= 0) then - info = 4000 - call psb_errpush(info,name) - goto 999 - endif - - itmpsz = 0 - itmpsz(me) = nl - call psb_sum(ictxt,itmpsz) - nlp=0 - do i=0, me-1 - nlp = nlp + itmpsz(i) - end do - call psb_cd_inloc((/(i,i=nlp+1,nlp+nl)/),ictxt,desc,info,globalcheck=.false.) + else if (present(repl)) then + if (.not.present(mg)) then + info=581 + call psb_errpush(info,name) + goto 999 + end if + if (.not.repl) then + info=581 + call psb_errpush(info,name) + goto 999 + end if + call psb_cdrep(mg, ictxt, desc, info) + else if (present(vg)) then + if (present(flag)) then + flag_=flag + else + flag_=0 endif + call psb_cdalv(vg, ictxt, desc, info, flag=flag_) - if (info /= 0) goto 999 + else if (present(vl)) then + call psb_cd_inloc(vl,ictxt,desc,info, globalcheck=globalcheck) - call psb_erractionrestore(err_act) - return + else if (present(nl)) then + allocate(itmpsz(0:np-1),stat=info) + if (info /= 0) then + info = 4000 + call psb_errpush(info,name) + goto 999 + endif -999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error(ictxt) - return - end if - return + itmpsz = 0 + itmpsz(me) = nl + call psb_sum(ictxt,itmpsz) + nlp=0 + do i=0, me-1 + nlp = nlp + itmpsz(i) + end do + call psb_cd_inloc((/(i,i=nlp+1,nlp+nl)/),ictxt,desc,info,globalcheck=.false.) + endif - end subroutine psb_cdall + if (info /= 0) goto 999 - subroutine psb_cdasb(desc,info) - use psb_descriptor_type + call psb_erractionrestore(err_act) + return - Type(psb_desc_type), intent(inout) :: desc - integer, intent(out) :: info +999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return - call psb_icdasb(desc,info,ext_hv=.false.) - end subroutine psb_cdasb -end module psb_base_tools_mod +end subroutine psb_cdall diff --git a/base/modules/psb_c_tools_mod.f90 b/base/modules/psb_c_tools_mod.f90 index 14aa375b..b6ecb110 100644 --- a/base/modules/psb_c_tools_mod.f90 +++ b/base/modules/psb_c_tools_mod.f90 @@ -34,7 +34,7 @@ Module psb_c_tools_mod interface psb_geall subroutine psb_calloc(x, desc_a, info, n, lb) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ implicit none complex(psb_spk_), allocatable, intent(out) :: x(:,:) type(psb_desc_type), intent(in) :: desc_a @@ -42,7 +42,7 @@ Module psb_c_tools_mod integer, optional, intent(in) :: n, lb end subroutine psb_calloc subroutine psb_callocv(x, desc_a,info,n) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ complex(psb_spk_), allocatable, intent(out) :: x(:) type(psb_desc_type), intent(in) :: desc_a integer, intent(out) :: info @@ -53,13 +53,13 @@ Module psb_c_tools_mod interface psb_geasb subroutine psb_casb(x, desc_a, info) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ type(psb_desc_type), intent(in) :: desc_a complex(psb_spk_), allocatable, intent(inout) :: x(:,:) integer, intent(out) :: info end subroutine psb_casb subroutine psb_casbv(x, desc_a, info) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ type(psb_desc_type), intent(in) :: desc_a complex(psb_spk_), allocatable, intent(inout) :: x(:) integer, intent(out) :: info @@ -69,7 +69,7 @@ Module psb_c_tools_mod interface psb_sphalo Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,& & rowscale,colscale,outfmt,data) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ use psb_mat_mod, only : psb_c_sparse_mat Type(psb_c_sparse_mat),Intent(in) :: a Type(psb_c_sparse_mat),Intent(inout) :: blk @@ -83,13 +83,13 @@ Module psb_c_tools_mod interface psb_gefree subroutine psb_cfree(x, desc_a, info) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ complex(psb_spk_),allocatable, intent(inout) :: x(:,:) type(psb_desc_type), intent(in) :: desc_a integer, intent(out) :: info end subroutine psb_cfree subroutine psb_cfreev(x, desc_a, info) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ complex(psb_spk_),allocatable, intent(inout) :: x(:) type(psb_desc_type), intent(in) :: desc_a integer, intent(out) :: info @@ -99,7 +99,7 @@ Module psb_c_tools_mod interface psb_geins subroutine psb_cinsi(m,irw,val, x, desc_a,info,dupl) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ integer, intent(in) :: m type(psb_desc_type), intent(in) :: desc_a complex(psb_spk_),intent(inout) :: x(:,:) @@ -109,7 +109,7 @@ Module psb_c_tools_mod integer, optional, intent(in) :: dupl end subroutine psb_cinsi subroutine psb_cinsvi(m, irw,val, x,desc_a,info,dupl) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ integer, intent(in) :: m type(psb_desc_type), intent(in) :: desc_a complex(psb_spk_),intent(inout) :: x(:) @@ -123,7 +123,7 @@ Module psb_c_tools_mod interface psb_cdbldext Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info,extype) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ use psb_mat_mod, only : psb_c_sparse_mat integer, intent(in) :: novr Type(psb_c_sparse_mat), Intent(in) :: a @@ -136,7 +136,7 @@ Module psb_c_tools_mod interface psb_spall subroutine psb_cspalloc(a, desc_a, info, nnz) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ use psb_mat_mod, only : psb_c_sparse_mat type(psb_desc_type), intent(inout) :: desc_a type(psb_c_sparse_mat), intent(out) :: a @@ -147,7 +147,7 @@ Module psb_c_tools_mod interface psb_spasb subroutine psb_cspasb(a,desc_a, info, afmt, upd, dupl,mold) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ use psb_mat_mod, only : psb_c_sparse_mat, psb_c_base_sparse_mat type(psb_c_sparse_mat), intent (inout) :: a type(psb_desc_type), intent(in) :: desc_a @@ -160,7 +160,7 @@ Module psb_c_tools_mod interface psb_spfree subroutine psb_cspfree(a, desc_a,info) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ use psb_mat_mod, only : psb_c_sparse_mat type(psb_desc_type), intent(in) :: desc_a type(psb_c_sparse_mat), intent(inout) ::a @@ -171,7 +171,7 @@ Module psb_c_tools_mod interface psb_spins subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ use psb_mat_mod, only : psb_c_sparse_mat type(psb_desc_type), intent(inout) :: desc_a type(psb_c_sparse_mat), intent(inout) :: a @@ -181,7 +181,7 @@ Module psb_c_tools_mod logical, intent(in), optional :: rebuild end subroutine psb_cspins subroutine psb_cspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ use psb_mat_mod, only : psb_c_sparse_mat type(psb_desc_type), intent(in) :: desc_ar type(psb_desc_type), intent(inout) :: desc_ac @@ -195,7 +195,7 @@ Module psb_c_tools_mod interface psb_sprn subroutine psb_csprn(a, desc_a,info,clear) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ use psb_mat_mod, only : psb_c_sparse_mat type(psb_desc_type), intent(in) :: desc_a type(psb_c_sparse_mat), intent(inout) :: a @@ -204,90 +204,90 @@ Module psb_c_tools_mod end subroutine psb_csprn end interface - - interface psb_linmap_init - module procedure psb_clinmap_init - end interface - - interface psb_linmap_ins - module procedure psb_clinmap_ins - end interface - - interface psb_linmap_asb - module procedure psb_clinmap_asb - end interface - -contains - subroutine psb_clinmap_init(a_map,cd_xt,descin,descout) - use psb_base_tools_mod - use psb_c_mat_mod - use psb_descriptor_type - use psb_serial_mod - use psb_penv_mod - use psb_error_mod - implicit none - type(psb_c_sparse_mat), intent(out) :: a_map - type(psb_desc_type), intent(out) :: cd_xt - type(psb_desc_type), intent(in) :: descin, descout - - integer :: nrow_in, nrow_out, ncol_in, info, ictxt - - ictxt = psb_cd_get_context(descin) - - call psb_cdcpy(descin,cd_xt,info) - if (info ==0) call psb_cd_reinit(cd_xt,info) - if (info /= 0) then - write(0,*) 'Error on reinitialising the extension map' - call psb_error(ictxt) - call psb_abort(ictxt) - stop - end if - - nrow_in = psb_cd_get_local_rows(cd_xt) - ncol_in = psb_cd_get_local_cols(cd_xt) - nrow_out = psb_cd_get_local_rows(descout) - - call a_map%csall(nrow_out,ncol_in,info) - - end subroutine psb_clinmap_init - - subroutine psb_clinmap_ins(nz,ir,ic,val,a_map,cd_xt,descin,descout) - use psb_base_tools_mod - use psb_c_mat_mod - use psb_descriptor_type - implicit none - integer, intent(in) :: nz - integer, intent(in) :: ir(:),ic(:) - complex(psb_spk_), intent(in) :: val(:) - type(psb_c_sparse_mat), intent(inout) :: a_map - type(psb_desc_type), intent(inout) :: cd_xt - type(psb_desc_type), intent(in) :: descin, descout - integer :: info - - call psb_spins(nz,ir,ic,val,a_map,descout,cd_xt,info) - - end subroutine psb_clinmap_ins - - subroutine psb_clinmap_asb(a_map,cd_xt,descin,descout,afmt) - use psb_base_tools_mod - use psb_c_mat_mod - use psb_descriptor_type - use psb_serial_mod - implicit none - type(psb_c_sparse_mat), intent(inout) :: a_map - type(psb_desc_type), intent(inout) :: cd_xt - type(psb_desc_type), intent(in) :: descin, descout - character(len=*), optional, intent(in) :: afmt - - integer :: nrow_in, nrow_out, ncol_in, info, ictxt - - ictxt = psb_cd_get_context(descin) - - call psb_cdasb(cd_xt,info) - call a_map%set_ncols(psb_cd_get_local_cols(cd_xt)) - call a_map%cscnv(info,type=afmt) - - end subroutine psb_clinmap_asb +!!$ +!!$ interface psb_linmap_init +!!$ module procedure psb_clinmap_init +!!$ end interface +!!$ +!!$ interface psb_linmap_ins +!!$ module procedure psb_clinmap_ins +!!$ end interface +!!$ +!!$ interface psb_linmap_asb +!!$ module procedure psb_clinmap_asb +!!$ end interface +!!$ +!!$contains +!!$ subroutine psb_clinmap_init(a_map,cd_xt,descin,descout) +!!$ use psb_base_tools_mod +!!$ use psb_c_mat_mod +!!$ use psb_descriptor_type +!!$ use psb_serial_mod +!!$ use psb_penv_mod +!!$ use psb_error_mod +!!$ implicit none +!!$ type(psb_c_sparse_mat), intent(out) :: a_map +!!$ type(psb_desc_type), intent(out) :: cd_xt +!!$ type(psb_desc_type), intent(in) :: descin, descout +!!$ +!!$ integer :: nrow_in, nrow_out, ncol_in, info, ictxt +!!$ +!!$ ictxt = psb_cd_get_context(descin) +!!$ +!!$ call psb_cdcpy(descin,cd_xt,info) +!!$ if (info ==0) call psb_cd_reinit(cd_xt,info) +!!$ if (info /= 0) then +!!$ write(0,*) 'Error on reinitialising the extension map' +!!$ call psb_error(ictxt) +!!$ call psb_abort(ictxt) +!!$ stop +!!$ end if +!!$ +!!$ nrow_in = psb_cd_get_local_rows(cd_xt) +!!$ ncol_in = psb_cd_get_local_cols(cd_xt) +!!$ nrow_out = psb_cd_get_local_rows(descout) +!!$ +!!$ call a_map%csall(nrow_out,ncol_in,info) +!!$ +!!$ end subroutine psb_clinmap_init +!!$ +!!$ subroutine psb_clinmap_ins(nz,ir,ic,val,a_map,cd_xt,descin,descout) +!!$ use psb_base_tools_mod +!!$ use psb_c_mat_mod +!!$ use psb_descriptor_type +!!$ implicit none +!!$ integer, intent(in) :: nz +!!$ integer, intent(in) :: ir(:),ic(:) +!!$ complex(psb_spk_), intent(in) :: val(:) +!!$ type(psb_c_sparse_mat), intent(inout) :: a_map +!!$ type(psb_desc_type), intent(inout) :: cd_xt +!!$ type(psb_desc_type), intent(in) :: descin, descout +!!$ integer :: info +!!$ +!!$ call psb_spins(nz,ir,ic,val,a_map,descout,cd_xt,info) +!!$ +!!$ end subroutine psb_clinmap_ins +!!$ +!!$ subroutine psb_clinmap_asb(a_map,cd_xt,descin,descout,afmt) +!!$ use psb_base_tools_mod +!!$ use psb_c_mat_mod +!!$ use psb_descriptor_type +!!$ use psb_serial_mod +!!$ implicit none +!!$ type(psb_c_sparse_mat), intent(inout) :: a_map +!!$ type(psb_desc_type), intent(inout) :: cd_xt +!!$ type(psb_desc_type), intent(in) :: descin, descout +!!$ character(len=*), optional, intent(in) :: afmt +!!$ +!!$ integer :: nrow_in, nrow_out, ncol_in, info, ictxt +!!$ +!!$ ictxt = psb_cd_get_context(descin) +!!$ +!!$ call psb_cdasb(cd_xt,info) +!!$ call a_map%set_ncols(psb_cd_get_local_cols(cd_xt)) +!!$ call a_map%cscnv(info,type=afmt) +!!$ +!!$ end subroutine psb_clinmap_asb end module psb_c_tools_mod diff --git a/base/modules/psb_d_tools_mod.f90 b/base/modules/psb_d_tools_mod.f90 index 81d77873..497a01be 100644 --- a/base/modules/psb_d_tools_mod.f90 +++ b/base/modules/psb_d_tools_mod.f90 @@ -34,7 +34,7 @@ Module psb_d_tools_mod interface psb_geall subroutine psb_dalloc(x, desc_a, info, n, lb) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ implicit none real(psb_dpk_), allocatable, intent(out) :: x(:,:) type(psb_desc_type), intent(in) :: desc_a @@ -42,7 +42,7 @@ Module psb_d_tools_mod integer, optional, intent(in) :: n, lb end subroutine psb_dalloc subroutine psb_dallocv(x, desc_a,info,n) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ real(psb_dpk_), allocatable, intent(out) :: x(:) type(psb_desc_type), intent(in) :: desc_a integer,intent(out) :: info @@ -53,13 +53,13 @@ Module psb_d_tools_mod interface psb_geasb subroutine psb_dasb(x, desc_a, info) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ type(psb_desc_type), intent(in) :: desc_a real(psb_dpk_), allocatable, intent(inout) :: x(:,:) integer, intent(out) :: info end subroutine psb_dasb subroutine psb_dasbv(x, desc_a, info) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ type(psb_desc_type), intent(in) :: desc_a real(psb_dpk_), allocatable, intent(inout) :: x(:) integer, intent(out) :: info @@ -69,7 +69,7 @@ Module psb_d_tools_mod interface psb_sphalo Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,& & rowscale,colscale,outfmt,data) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ use psb_mat_mod, only : psb_d_sparse_mat Type(psb_d_sparse_mat),Intent(in) :: a Type(psb_d_sparse_mat),Intent(inout) :: blk @@ -83,13 +83,13 @@ Module psb_d_tools_mod interface psb_gefree subroutine psb_dfree(x, desc_a, info) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ real(psb_dpk_),allocatable, intent(inout) :: x(:,:) type(psb_desc_type), intent(in) :: desc_a integer, intent(out) :: info end subroutine psb_dfree subroutine psb_dfreev(x, desc_a, info) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ real(psb_dpk_),allocatable, intent(inout) :: x(:) type(psb_desc_type), intent(in) :: desc_a integer, intent(out) :: info @@ -98,7 +98,7 @@ Module psb_d_tools_mod interface psb_geins subroutine psb_dinsi(m,irw,val, x,desc_a,info,dupl) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ integer, intent(in) :: m type(psb_desc_type), intent(in) :: desc_a real(psb_dpk_),intent(inout) :: x(:,:) @@ -108,7 +108,7 @@ Module psb_d_tools_mod integer, optional, intent(in) :: dupl end subroutine psb_dinsi subroutine psb_dinsvi(m,irw,val,x,desc_a,info,dupl) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ integer, intent(in) :: m type(psb_desc_type), intent(in) :: desc_a real(psb_dpk_),intent(inout) :: x(:) @@ -122,7 +122,7 @@ Module psb_d_tools_mod interface psb_cdbldext Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info,extype) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ Use psb_mat_mod, only : psb_d_sparse_mat integer, intent(in) :: novr Type(psb_d_sparse_mat), Intent(in) :: a @@ -135,7 +135,7 @@ Module psb_d_tools_mod interface psb_spall subroutine psb_dspalloc(a, desc_a, info, nnz) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ use psb_mat_mod, only : psb_d_sparse_mat type(psb_desc_type), intent(inout) :: desc_a type(psb_d_sparse_mat), intent(out) :: a @@ -146,7 +146,7 @@ Module psb_d_tools_mod interface psb_spasb subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl,mold) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ use psb_mat_mod, only : psb_d_sparse_mat, psb_d_base_sparse_mat type(psb_d_sparse_mat), intent (inout) :: a type(psb_desc_type), intent(in) :: desc_a @@ -159,7 +159,7 @@ Module psb_d_tools_mod interface psb_spfree subroutine psb_dspfree(a, desc_a,info) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ use psb_mat_mod, only : psb_d_sparse_mat type(psb_desc_type), intent(in) :: desc_a type(psb_d_sparse_mat), intent(inout) :: a @@ -170,7 +170,7 @@ Module psb_d_tools_mod interface psb_spins subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ use psb_mat_mod, only : psb_d_sparse_mat type(psb_desc_type), intent(inout) :: desc_a type(psb_d_sparse_mat), intent(inout) :: a @@ -180,7 +180,7 @@ Module psb_d_tools_mod logical, intent(in), optional :: rebuild end subroutine psb_dspins subroutine psb_dspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ use psb_mat_mod, only : psb_d_sparse_mat type(psb_d_sparse_mat), intent(inout) :: a type(psb_desc_type), intent(in) :: desc_ar @@ -194,7 +194,7 @@ Module psb_d_tools_mod interface psb_sprn subroutine psb_dsprn(a, desc_a,info,clear) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ use psb_mat_mod, only : psb_d_sparse_mat type(psb_desc_type), intent(in) :: desc_a type(psb_d_sparse_mat), intent(inout) :: a @@ -203,88 +203,88 @@ Module psb_d_tools_mod end subroutine psb_dsprn end interface - - interface psb_linmap_init - module procedure psb_dlinmap_init - end interface - - interface psb_linmap_ins - module procedure psb_dlinmap_ins - end interface - - interface psb_linmap_asb - module procedure psb_dlinmap_asb - end interface - -contains - - subroutine psb_dlinmap_init(a_map,cd_xt,descin,descout) - use psb_descriptor_type - use psb_serial_mod - use psb_penv_mod - use psb_error_mod - use psb_base_tools_mod - use psb_d_mat_mod - implicit none - type(psb_d_sparse_mat), intent(out) :: a_map - type(psb_desc_type), intent(out) :: cd_xt - type(psb_desc_type), intent(in) :: descin, descout - - integer :: nrow_in, nrow_out, ncol_in, info, ictxt - - ictxt = psb_cd_get_context(descin) - call psb_cdcpy(descin,cd_xt,info) - if (info ==0) call psb_cd_reinit(cd_xt,info) - if (info /= 0) then - write(0,*) 'Error on reinitialising the extension map' - call psb_error(ictxt) - call psb_abort(ictxt) - stop - end if - - nrow_in = psb_cd_get_local_rows(cd_xt) - ncol_in = psb_cd_get_local_cols(cd_xt) - nrow_out = psb_cd_get_local_rows(descout) - - call a_map%csall(nrow_out,ncol_in,info) - - end subroutine psb_dlinmap_init - - subroutine psb_dlinmap_ins(nz,ir,ic,val,a_map,cd_xt,descin,descout) - use psb_d_mat_mod - use psb_descriptor_type - implicit none - integer, intent(in) :: nz - integer, intent(in) :: ir(:),ic(:) - real(psb_dpk_), intent(in) :: val(:) - type(psb_d_sparse_mat), intent(inout) :: a_map - type(psb_desc_type), intent(inout) :: cd_xt - type(psb_desc_type), intent(in) :: descin, descout - integer :: info - call psb_spins(nz,ir,ic,val,a_map,descout,cd_xt,info) - - end subroutine psb_dlinmap_ins - - subroutine psb_dlinmap_asb(a_map,cd_xt,descin,descout,afmt) - use psb_base_tools_mod - use psb_d_mat_mod - use psb_descriptor_type - use psb_serial_mod - implicit none - type(psb_d_sparse_mat), intent(inout) :: a_map - type(psb_desc_type), intent(inout) :: cd_xt - type(psb_desc_type), intent(in) :: descin, descout - character(len=*), optional, intent(in) :: afmt - - - integer :: nrow_in, nrow_out, ncol_in, info, ictxt - - ictxt = psb_cd_get_context(descin) - - call psb_cdasb(cd_xt,info) - call a_map%set_ncols(psb_cd_get_local_cols(cd_xt)) - call a_map%cscnv(info,type=afmt) - - end subroutine psb_dlinmap_asb - +!!$ +!!$ interface psb_linmap_init +!!$ module procedure psb_dlinmap_init +!!$ end interface +!!$ +!!$ interface psb_linmap_ins +!!$ module procedure psb_dlinmap_ins +!!$ end interface +!!$ +!!$ interface psb_linmap_asb +!!$ module procedure psb_dlinmap_asb +!!$ end interface +!!$ +!!$contains +!!$ +!!$ subroutine psb_dlinmap_init(a_map,cd_xt,descin,descout) +!!$ use psb_descriptor_type +!!$ use psb_serial_mod +!!$ use psb_penv_mod +!!$ use psb_error_mod +!!$ use psb_base_tools_mod +!!$ use psb_d_mat_mod +!!$ implicit none +!!$ type(psb_d_sparse_mat), intent(out) :: a_map +!!$ type(psb_desc_type), intent(out) :: cd_xt +!!$ type(psb_desc_type), intent(in) :: descin, descout +!!$ +!!$ integer :: nrow_in, nrow_out, ncol_in, info, ictxt +!!$ +!!$ ictxt = psb_cd_get_context(descin) +!!$ call psb_cdcpy(descin,cd_xt,info) +!!$ if (info ==0) call psb_cd_reinit(cd_xt,info) +!!$ if (info /= 0) then +!!$ write(0,*) 'Error on reinitialising the extension map' +!!$ call psb_error(ictxt) +!!$ call psb_abort(ictxt) +!!$ stop +!!$ end if +!!$ +!!$ nrow_in = psb_cd_get_local_rows(cd_xt) +!!$ ncol_in = psb_cd_get_local_cols(cd_xt) +!!$ nrow_out = psb_cd_get_local_rows(descout) +!!$ +!!$ call a_map%csall(nrow_out,ncol_in,info) +!!$ +!!$ end subroutine psb_dlinmap_init +!!$ +!!$ subroutine psb_dlinmap_ins(nz,ir,ic,val,a_map,cd_xt,descin,descout) +!!$ use psb_d_mat_mod +!!$ use psb_descriptor_type +!!$ implicit none +!!$ integer, intent(in) :: nz +!!$ integer, intent(in) :: ir(:),ic(:) +!!$ real(psb_dpk_), intent(in) :: val(:) +!!$ type(psb_d_sparse_mat), intent(inout) :: a_map +!!$ type(psb_desc_type), intent(inout) :: cd_xt +!!$ type(psb_desc_type), intent(in) :: descin, descout +!!$ integer :: info +!!$ call psb_spins(nz,ir,ic,val,a_map,descout,cd_xt,info) +!!$ +!!$ end subroutine psb_dlinmap_ins +!!$ +!!$ subroutine psb_dlinmap_asb(a_map,cd_xt,descin,descout,afmt) +!!$ use psb_base_tools_mod +!!$ use psb_d_mat_mod +!!$ use psb_descriptor_type +!!$ use psb_serial_mod +!!$ implicit none +!!$ type(psb_d_sparse_mat), intent(inout) :: a_map +!!$ type(psb_desc_type), intent(inout) :: cd_xt +!!$ type(psb_desc_type), intent(in) :: descin, descout +!!$ character(len=*), optional, intent(in) :: afmt +!!$ +!!$ +!!$ integer :: nrow_in, nrow_out, ncol_in, info, ictxt +!!$ +!!$ ictxt = psb_cd_get_context(descin) +!!$ +!!$ call psb_cdasb(cd_xt,info) +!!$ call a_map%set_ncols(psb_cd_get_local_cols(cd_xt)) +!!$ call a_map%cscnv(info,type=afmt) +!!$ +!!$ end subroutine psb_dlinmap_asb +!!$ end module psb_d_tools_mod diff --git a/base/modules/psb_linmap_mod.f90 b/base/modules/psb_linmap_mod.f90 index e842754a..edd1f315 100644 --- a/base/modules/psb_linmap_mod.f90 +++ b/base/modules/psb_linmap_mod.f90 @@ -35,10 +35,9 @@ ! Defines facilities for mapping between vectors belonging ! to different spaces. ! -module psb_linmap_mod +module psb_s_linmap_mod use psb_const_mod - use psb_descriptor_type use psb_linmap_type_mod @@ -53,36 +52,6 @@ module psb_linmap_mod integer, intent(out) :: info real(psb_spk_), optional :: work(:) end subroutine psb_s_map_X2Y - subroutine psb_d_map_X2Y(alpha,x,beta,y,map,info,work) - use psb_linmap_type_mod - implicit none - type(psb_dlinmap_type), intent(in) :: map - real(psb_dpk_), intent(in) :: alpha,beta - real(psb_dpk_), intent(inout) :: x(:) - real(psb_dpk_), intent(out) :: y(:) - integer, intent(out) :: info - real(psb_dpk_), optional :: work(:) - end subroutine psb_d_map_X2Y - subroutine psb_c_map_X2Y(alpha,x,beta,y,map,info,work) - use psb_linmap_type_mod - implicit none - type(psb_clinmap_type), intent(in) :: map - complex(psb_spk_), intent(in) :: alpha,beta - complex(psb_spk_), intent(inout) :: x(:) - complex(psb_spk_), intent(out) :: y(:) - integer, intent(out) :: info - complex(psb_spk_), optional :: work(:) - end subroutine psb_c_map_X2Y - subroutine psb_z_map_X2Y(alpha,x,beta,y,map,info,work) - use psb_linmap_type_mod - implicit none - type(psb_zlinmap_type), intent(in) :: map - complex(psb_dpk_), intent(in) :: alpha,beta - complex(psb_dpk_), intent(inout) :: x(:) - complex(psb_dpk_), intent(out) :: y(:) - integer, intent(out) :: info - complex(psb_dpk_), optional :: work(:) - end subroutine psb_z_map_X2Y end interface interface psb_map_Y2X @@ -96,67 +65,31 @@ module psb_linmap_mod integer, intent(out) :: info real(psb_spk_), optional :: work(:) end subroutine psb_s_map_Y2X - subroutine psb_d_map_Y2X(alpha,x,beta,y,map,info,work) - use psb_linmap_type_mod - implicit none - type(psb_dlinmap_type), intent(in) :: map - real(psb_dpk_), intent(in) :: alpha,beta - real(psb_dpk_), intent(inout) :: x(:) - real(psb_dpk_), intent(out) :: y(:) - integer, intent(out) :: info - real(psb_dpk_), optional :: work(:) - end subroutine psb_d_map_Y2X - subroutine psb_c_map_Y2X(alpha,x,beta,y,map,info,work) - use psb_linmap_type_mod - implicit none - type(psb_clinmap_type), intent(in) :: map - complex(psb_spk_), intent(in) :: alpha,beta - complex(psb_spk_), intent(inout) :: x(:) - complex(psb_spk_), intent(out) :: y(:) - integer, intent(out) :: info - complex(psb_spk_), optional :: work(:) - end subroutine psb_c_map_Y2X - subroutine psb_z_map_Y2X(alpha,x,beta,y,map,info,work) - use psb_linmap_type_mod - implicit none - type(psb_zlinmap_type), intent(in) :: map - complex(psb_dpk_), intent(in) :: alpha,beta - complex(psb_dpk_), intent(inout) :: x(:) - complex(psb_dpk_), intent(out) :: y(:) - integer, intent(out) :: info - complex(psb_dpk_), optional :: work(:) - end subroutine psb_z_map_Y2X end interface interface psb_is_ok_map - module procedure psb_is_ok_slinmap, psb_is_ok_dlinmap, & - & psb_is_ok_clinmap, psb_is_ok_zlinmap + module procedure psb_is_ok_slinmap end interface interface psb_get_map_kind - module procedure psb_get_smap_kind, psb_get_dmap_kind, & - & psb_get_cmap_kind, psb_get_zmap_kind + module procedure psb_get_smap_kind end interface interface psb_set_map_kind - module procedure psb_set_smap_kind, psb_set_dmap_kind, & - & psb_set_cmap_kind, psb_set_zmap_kind + module procedure psb_set_smap_kind end interface interface psb_is_asb_map - module procedure psb_is_asb_slinmap, psb_is_asb_dlinmap, & - & psb_is_asb_clinmap, psb_is_asb_zlinmap + module procedure psb_is_asb_slinmap end interface interface psb_linmap_sub - module procedure psb_s_linmap_sub, psb_d_linmap_sub, & - & psb_c_linmap_sub, psb_z_linmap_sub + module procedure psb_s_linmap_sub end interface interface psb_move_alloc - module procedure psb_slinmap_transfer, psb_dlinmap_transfer, & - & psb_clinmap_transfer, psb_zlinmap_transfer + module procedure psb_slinmap_transfer end interface interface psb_linmap @@ -169,38 +102,10 @@ module psb_linmap_mod integer, intent(in) :: map_kind integer, intent(in), optional :: iaggr(:), naggr(:) end function psb_s_linmap - function psb_d_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) - use psb_linmap_type_mod - implicit none - type(psb_dlinmap_type) :: psb_d_linmap - type(psb_desc_type), target :: desc_X, desc_Y - type(psb_d_sparse_mat), intent(in) :: map_X2Y, map_Y2X - integer, intent(in) :: map_kind - integer, intent(in), optional :: iaggr(:), naggr(:) - end function psb_d_linmap - function psb_c_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) - use psb_linmap_type_mod - implicit none - type(psb_clinmap_type) :: psb_c_linmap - type(psb_desc_type), target :: desc_X, desc_Y - type(psb_c_sparse_mat), intent(in) :: map_X2Y, map_Y2X - integer, intent(in) :: map_kind - integer, intent(in), optional :: iaggr(:), naggr(:) - end function psb_c_linmap - function psb_z_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) - use psb_linmap_type_mod - implicit none - type(psb_zlinmap_type) :: psb_z_linmap - type(psb_desc_type), target :: desc_X, desc_Y - type(psb_z_sparse_mat), intent(in) :: map_X2Y, map_Y2X - integer, intent(in) :: map_kind - integer, intent(in), optional :: iaggr(:), naggr(:) - end function psb_z_linmap end interface interface psb_sizeof - module procedure psb_slinmap_sizeof, psb_dlinmap_sizeof, & - & psb_clinmap_sizeof, psb_zlinmap_sizeof + module procedure psb_slinmap_sizeof end interface contains @@ -216,37 +121,7 @@ contains end if end function psb_get_smap_kind - function psb_get_dmap_kind(map) - implicit none - type(psb_dlinmap_type), intent(in) :: map - Integer :: psb_get_dmap_kind - if (allocated(map%itd_data)) then - psb_get_dmap_kind = map%itd_data(psb_map_kind_) - else - psb_get_dmap_kind = -1 - end if - end function psb_get_dmap_kind - function psb_get_cmap_kind(map) - implicit none - type(psb_clinmap_type), intent(in) :: map - Integer :: psb_get_cmap_kind - if (allocated(map%itd_data)) then - psb_get_cmap_kind = map%itd_data(psb_map_kind_) - else - psb_get_cmap_kind = -1 - end if - end function psb_get_cmap_kind - function psb_get_zmap_kind(map) - implicit none - type(psb_zlinmap_type), intent(in) :: map - Integer :: psb_get_zmap_kind - if (allocated(map%itd_data)) then - psb_get_zmap_kind = map%itd_data(psb_map_kind_) - else - psb_get_zmap_kind = -1 - end if - end function psb_get_zmap_kind - + subroutine psb_set_smap_kind(map_kind,map) implicit none integer, intent(in) :: map_kind @@ -255,33 +130,10 @@ contains map%itd_data(psb_map_kind_) = map_kind end subroutine psb_set_smap_kind - subroutine psb_set_dmap_kind(map_kind,map) - implicit none - integer, intent(in) :: map_kind - type(psb_dlinmap_type), intent(inout) :: map - - map%itd_data(psb_map_kind_) = map_kind - - end subroutine psb_set_dmap_kind - subroutine psb_set_cmap_kind(map_kind,map) - implicit none - integer, intent(in) :: map_kind - type(psb_clinmap_type), intent(inout) :: map - - map%itd_data(psb_map_kind_) = map_kind - - end subroutine psb_set_cmap_kind - subroutine psb_set_zmap_kind(map_kind,map) - implicit none - integer, intent(in) :: map_kind - type(psb_zlinmap_type), intent(inout) :: map - - map%itd_data(psb_map_kind_) = map_kind - - end subroutine psb_set_zmap_kind function psb_is_asb_slinmap(map) result(this) + use psb_descriptor_type implicit none type(psb_slinmap_type), intent(in) :: map logical :: this @@ -304,83 +156,214 @@ contains end function psb_is_asb_slinmap - function psb_is_asb_dlinmap(map) result(this) + function psb_is_ok_slinmap(map) result(this) + use psb_descriptor_type implicit none - type(psb_dlinmap_type), intent(in) :: map - logical :: this - + type(psb_slinmap_type), intent(in) :: map + logical :: this this = .false. if (.not.allocated(map%itd_data)) return select case(psb_get_map_kind(map)) case (psb_map_aggr_) if (.not.associated(map%p_desc_X)) return if (.not.associated(map%p_desc_Y)) return - this = & - & psb_is_asb_desc(map%p_desc_X).and.psb_is_asb_desc(map%p_desc_Y) - + this = & + & psb_is_ok_desc(map%p_desc_X).and.psb_is_ok_desc(map%p_desc_Y) case(psb_map_gen_linear_) - this = & - & psb_is_asb_desc(map%desc_X).and.psb_is_asb_desc(map%desc_Y) - + & psb_is_ok_desc(map%desc_X).and.psb_is_ok_desc(map%desc_Y) end select - end function psb_is_asb_dlinmap + end function psb_is_ok_slinmap - function psb_is_asb_clinmap(map) result(this) + function psb_slinmap_sizeof(map) result(val) + use psb_descriptor_type + use psb_mat_mod, only : psb_sizeof implicit none - type(psb_clinmap_type), intent(in) :: map - logical :: this - - this = .false. - if (.not.allocated(map%itd_data)) return - select case(psb_get_map_kind(map)) - case (psb_map_aggr_) - if (.not.associated(map%p_desc_X)) return - if (.not.associated(map%p_desc_Y)) return - this = & - & psb_is_asb_desc(map%p_desc_X).and.psb_is_asb_desc(map%p_desc_Y) + type(psb_slinmap_type), intent(in) :: map + integer(psb_long_int_k_) :: val - case(psb_map_gen_linear_) + val = 0 + if (allocated(map%itd_data)) & + & val = val + psb_sizeof_int*size(map%itd_data) + if (allocated(map%iaggr)) & + & val = val + psb_sizeof_int*size(map%iaggr) + if (allocated(map%naggr)) & + & val = val + psb_sizeof_int*size(map%naggr) + val = val + psb_sizeof(map%desc_X) + val = val + psb_sizeof(map%desc_Y) + val = val + psb_sizeof(map%map_X2Y) + val = val + psb_sizeof(map%map_Y2X) - this = & - & psb_is_asb_desc(map%desc_X).and.psb_is_asb_desc(map%desc_Y) + end function psb_slinmap_sizeof - end select - end function psb_is_asb_clinmap + subroutine psb_s_linmap_sub(out_map,map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) + use psb_linmap_type_mod + implicit none + type(psb_slinmap_type), intent(out) :: out_map + type(psb_desc_type), target :: desc_X, desc_Y + type(psb_s_sparse_mat), intent(in) :: map_X2Y, map_Y2X + integer, intent(in) :: map_kind + integer, intent(in), optional :: iaggr(:), naggr(:) + out_map = psb_linmap(map_kind,desc_X,desc_Y,map_X2Y,map_Y2X,iaggr,naggr) + end subroutine psb_s_linmap_sub - function psb_is_asb_zlinmap(map) result(this) + + subroutine psb_slinmap_transfer(mapin,mapout,info) + use psb_realloc_mod + use psb_descriptor_type + use psb_mat_mod, only : psb_move_alloc implicit none - type(psb_zlinmap_type), intent(in) :: map - logical :: this + type(psb_slinmap_type) :: mapin,mapout + integer, intent(out) :: info + + call psb_move_alloc(mapin%itd_data,mapout%itd_data,info) + call psb_move_alloc(mapin%iaggr,mapout%iaggr,info) + call psb_move_alloc(mapin%naggr,mapout%naggr,info) + mapout%p_desc_X => mapin%p_desc_X + mapin%p_desc_X => null() + mapout%p_desc_Y => mapin%p_desc_Y + mapin%p_desc_Y => null() + call psb_move_alloc(mapin%desc_X,mapout%desc_X,info) + call psb_move_alloc(mapin%desc_Y,mapout%desc_Y,info) + call psb_move_alloc(mapin%map_X2Y,mapout%map_X2Y,info) + call psb_move_alloc(mapin%map_Y2X,mapout%map_Y2X,info) - this = .false. - if (.not.allocated(map%itd_data)) return - select case(psb_get_map_kind(map)) - case (psb_map_aggr_) - if (.not.associated(map%p_desc_X)) return - if (.not.associated(map%p_desc_Y)) return - this = & - & psb_is_asb_desc(map%p_desc_X).and.psb_is_asb_desc(map%p_desc_Y) + end subroutine psb_slinmap_transfer + - case(psb_map_gen_linear_) +end module psb_s_linmap_mod - this = & - & psb_is_asb_desc(map%desc_X).and.psb_is_asb_desc(map%desc_Y) +module psb_d_linmap_mod - end select + use psb_const_mod + use psb_linmap_type_mod - end function psb_is_asb_zlinmap - function psb_is_ok_slinmap(map) result(this) - implicit none - type(psb_slinmap_type), intent(in) :: map - logical :: this - this = .false. - if (.not.allocated(map%itd_data)) return - select case(psb_get_map_kind(map)) - case (psb_map_aggr_) + interface psb_map_X2Y + subroutine psb_d_map_X2Y(alpha,x,beta,y,map,info,work) + use psb_linmap_type_mod + implicit none + type(psb_dlinmap_type), intent(in) :: map + real(psb_dpk_), intent(in) :: alpha,beta + real(psb_dpk_), intent(inout) :: x(:) + real(psb_dpk_), intent(out) :: y(:) + integer, intent(out) :: info + real(psb_dpk_), optional :: work(:) + end subroutine psb_d_map_X2Y + end interface + + interface psb_map_Y2X + subroutine psb_d_map_Y2X(alpha,x,beta,y,map,info,work) + use psb_linmap_type_mod + implicit none + type(psb_dlinmap_type), intent(in) :: map + real(psb_dpk_), intent(in) :: alpha,beta + real(psb_dpk_), intent(inout) :: x(:) + real(psb_dpk_), intent(out) :: y(:) + integer, intent(out) :: info + real(psb_dpk_), optional :: work(:) + end subroutine psb_d_map_Y2X + end interface + + + interface psb_is_ok_map + module procedure psb_is_ok_dlinmap + end interface + + interface psb_get_map_kind + module procedure psb_get_dmap_kind + end interface + + interface psb_set_map_kind + module procedure psb_set_dmap_kind + end interface + + interface psb_is_asb_map + module procedure psb_is_asb_dlinmap + end interface + + interface psb_linmap_sub + module procedure psb_d_linmap_sub + end interface + + interface psb_move_alloc + module procedure psb_dlinmap_transfer + end interface + + interface psb_linmap + function psb_d_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) + use psb_linmap_type_mod + implicit none + type(psb_dlinmap_type) :: psb_d_linmap + type(psb_desc_type), target :: desc_X, desc_Y + type(psb_d_sparse_mat), intent(in) :: map_X2Y, map_Y2X + integer, intent(in) :: map_kind + integer, intent(in), optional :: iaggr(:), naggr(:) + end function psb_d_linmap + end interface + + interface psb_sizeof + module procedure psb_dlinmap_sizeof + end interface + +contains + + function psb_get_dmap_kind(map) + implicit none + type(psb_dlinmap_type), intent(in) :: map + Integer :: psb_get_dmap_kind + if (allocated(map%itd_data)) then + psb_get_dmap_kind = map%itd_data(psb_map_kind_) + else + psb_get_dmap_kind = -1 + end if + end function psb_get_dmap_kind + + + subroutine psb_set_dmap_kind(map_kind,map) + implicit none + integer, intent(in) :: map_kind + type(psb_dlinmap_type), intent(inout) :: map + + map%itd_data(psb_map_kind_) = map_kind + + end subroutine psb_set_dmap_kind + + function psb_is_asb_dlinmap(map) result(this) + use psb_descriptor_type + implicit none + type(psb_dlinmap_type), intent(in) :: map + logical :: this + + this = .false. + if (.not.allocated(map%itd_data)) return + select case(psb_get_map_kind(map)) + case (psb_map_aggr_) + if (.not.associated(map%p_desc_X)) return + if (.not.associated(map%p_desc_Y)) return + this = & + & psb_is_asb_desc(map%p_desc_X).and.psb_is_asb_desc(map%p_desc_Y) + + case(psb_map_gen_linear_) + + this = & + & psb_is_asb_desc(map%desc_X).and.psb_is_asb_desc(map%desc_Y) + + end select + + end function psb_is_asb_dlinmap + + function psb_is_ok_dlinmap(map) result(this) + use psb_descriptor_type + implicit none + type(psb_dlinmap_type), intent(in) :: map + logical :: this + this = .false. + if (.not.allocated(map%itd_data)) return + select case(psb_get_map_kind(map)) + case (psb_map_aggr_) if (.not.associated(map%p_desc_X)) return if (.not.associated(map%p_desc_Y)) return this = & @@ -390,47 +373,380 @@ contains & psb_is_ok_desc(map%desc_X).and.psb_is_ok_desc(map%desc_Y) end select - end function psb_is_ok_slinmap + end function psb_is_ok_dlinmap + + function psb_dlinmap_sizeof(map) result(val) + use psb_descriptor_type + use psb_mat_mod, only : psb_sizeof + implicit none + type(psb_dlinmap_type), intent(in) :: map + integer(psb_long_int_k_) :: val + + val = 0 + if (allocated(map%itd_data)) & + & val = val + psb_sizeof_int*size(map%itd_data) + if (allocated(map%iaggr)) & + & val = val + psb_sizeof_int*size(map%iaggr) + if (allocated(map%naggr)) & + & val = val + psb_sizeof_int*size(map%naggr) + val = val + psb_sizeof(map%desc_X) + val = val + psb_sizeof(map%desc_Y) + val = val + psb_sizeof(map%map_X2Y) + val = val + psb_sizeof(map%map_Y2X) + + end function psb_dlinmap_sizeof + + subroutine psb_d_linmap_sub(out_map,map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) + use psb_linmap_type_mod + implicit none + type(psb_dlinmap_type), intent(out) :: out_map + type(psb_desc_type), target :: desc_X, desc_Y + type(psb_d_sparse_mat), intent(in) :: map_X2Y, map_Y2X + integer, intent(in) :: map_kind + integer, intent(in), optional :: iaggr(:), naggr(:) + out_map = psb_linmap(map_kind,desc_X,desc_Y,map_X2Y,map_Y2X,iaggr,naggr) + end subroutine psb_d_linmap_sub + + subroutine psb_dlinmap_transfer(mapin,mapout,info) + use psb_realloc_mod + use psb_descriptor_type + use psb_mat_mod, only : psb_move_alloc + implicit none + type(psb_dlinmap_type) :: mapin,mapout + integer, intent(out) :: info + + call psb_move_alloc(mapin%itd_data,mapout%itd_data,info) + call psb_move_alloc(mapin%iaggr,mapout%iaggr,info) + call psb_move_alloc(mapin%naggr,mapout%naggr,info) + mapout%p_desc_X => mapin%p_desc_X + mapin%p_desc_X => null() + mapout%p_desc_Y => mapin%p_desc_Y + mapin%p_desc_Y => null() + call psb_move_alloc(mapin%desc_X,mapout%desc_X,info) + call psb_move_alloc(mapin%desc_Y,mapout%desc_Y,info) + call psb_move_alloc(mapin%map_X2Y,mapout%map_X2Y,info) + call psb_move_alloc(mapin%map_Y2X,mapout%map_Y2X,info) + + end subroutine psb_dlinmap_transfer + +end module psb_d_linmap_mod + +module psb_c_linmap_mod + + use psb_const_mod + use psb_linmap_type_mod + + + interface psb_map_X2Y + subroutine psb_c_map_X2Y(alpha,x,beta,y,map,info,work) + use psb_linmap_type_mod + implicit none + type(psb_clinmap_type), intent(in) :: map + complex(psb_spk_), intent(in) :: alpha,beta + complex(psb_spk_), intent(inout) :: x(:) + complex(psb_spk_), intent(out) :: y(:) + integer, intent(out) :: info + complex(psb_spk_), optional :: work(:) + end subroutine psb_c_map_X2Y + end interface + + interface psb_map_Y2X + subroutine psb_c_map_Y2X(alpha,x,beta,y,map,info,work) + use psb_linmap_type_mod + implicit none + type(psb_clinmap_type), intent(in) :: map + complex(psb_spk_), intent(in) :: alpha,beta + complex(psb_spk_), intent(inout) :: x(:) + complex(psb_spk_), intent(out) :: y(:) + integer, intent(out) :: info + complex(psb_spk_), optional :: work(:) + end subroutine psb_c_map_Y2X + end interface + + + interface psb_is_ok_map + module procedure psb_is_ok_clinmap + end interface + + interface psb_get_map_kind + module procedure psb_get_cmap_kind + end interface + + interface psb_set_map_kind + module procedure psb_set_cmap_kind + end interface + + interface psb_is_asb_map + module procedure psb_is_asb_clinmap + end interface + + interface psb_linmap_sub + module procedure psb_c_linmap_sub + end interface + + interface psb_move_alloc + module procedure psb_clinmap_transfer + end interface + + interface psb_linmap + function psb_c_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) + use psb_linmap_type_mod + implicit none + type(psb_clinmap_type) :: psb_c_linmap + type(psb_desc_type), target :: desc_X, desc_Y + type(psb_c_sparse_mat), intent(in) :: map_X2Y, map_Y2X + integer, intent(in) :: map_kind + integer, intent(in), optional :: iaggr(:), naggr(:) + end function psb_c_linmap + end interface + + interface psb_sizeof + module procedure psb_clinmap_sizeof + end interface + +contains + + function psb_get_cmap_kind(map) + implicit none + type(psb_clinmap_type), intent(in) :: map + Integer :: psb_get_cmap_kind + if (allocated(map%itd_data)) then + psb_get_cmap_kind = map%itd_data(psb_map_kind_) + else + psb_get_cmap_kind = -1 + end if + end function psb_get_cmap_kind + + subroutine psb_set_cmap_kind(map_kind,map) + implicit none + integer, intent(in) :: map_kind + type(psb_clinmap_type), intent(inout) :: map + + map%itd_data(psb_map_kind_) = map_kind + + end subroutine psb_set_cmap_kind + + function psb_is_asb_clinmap(map) result(this) + use psb_descriptor_type + implicit none + type(psb_clinmap_type), intent(in) :: map + logical :: this + + this = .false. + if (.not.allocated(map%itd_data)) return + select case(psb_get_map_kind(map)) + case (psb_map_aggr_) + if (.not.associated(map%p_desc_X)) return + if (.not.associated(map%p_desc_Y)) return + this = & + & psb_is_asb_desc(map%p_desc_X).and.psb_is_asb_desc(map%p_desc_Y) + + case(psb_map_gen_linear_) + + this = & + & psb_is_asb_desc(map%desc_X).and.psb_is_asb_desc(map%desc_Y) + + end select + + end function psb_is_asb_clinmap + + function psb_is_ok_clinmap(map) result(this) + use psb_descriptor_type + implicit none + type(psb_clinmap_type), intent(in) :: map + logical :: this + this = .false. + if (.not.allocated(map%itd_data)) return + select case(psb_get_map_kind(map)) + case (psb_map_aggr_) + if (.not.associated(map%p_desc_X)) return + if (.not.associated(map%p_desc_Y)) return + this = & + & psb_is_ok_desc(map%p_desc_X).and.psb_is_ok_desc(map%p_desc_Y) + case(psb_map_gen_linear_) + this = & + & psb_is_ok_desc(map%desc_X).and.psb_is_ok_desc(map%desc_Y) + end select + + end function psb_is_ok_clinmap + + function psb_clinmap_sizeof(map) result(val) + use psb_descriptor_type + use psb_mat_mod, only : psb_sizeof + implicit none + type(psb_clinmap_type), intent(in) :: map + integer(psb_long_int_k_) :: val + + val = 0 + if (allocated(map%itd_data)) & + & val = val + psb_sizeof_int*size(map%itd_data) + if (allocated(map%iaggr)) & + & val = val + psb_sizeof_int*size(map%iaggr) + if (allocated(map%naggr)) & + & val = val + psb_sizeof_int*size(map%naggr) + val = val + psb_sizeof(map%desc_X) + val = val + psb_sizeof(map%desc_Y) + val = val + psb_sizeof(map%map_X2Y) + val = val + psb_sizeof(map%map_Y2X) + + end function psb_clinmap_sizeof + + subroutine psb_c_linmap_sub(out_map,map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) + use psb_linmap_type_mod + implicit none + type(psb_clinmap_type), intent(out) :: out_map + type(psb_desc_type), target :: desc_X, desc_Y + type(psb_c_sparse_mat), intent(in) :: map_X2Y, map_Y2X + integer, intent(in) :: map_kind + integer, intent(in), optional :: iaggr(:), naggr(:) + out_map = psb_linmap(map_kind,desc_X,desc_Y,map_X2Y,map_Y2X,iaggr,naggr) + end subroutine psb_c_linmap_sub + + subroutine psb_clinmap_transfer(mapin,mapout,info) + use psb_realloc_mod + use psb_mat_mod, only : psb_move_alloc + use psb_descriptor_type + implicit none + type(psb_clinmap_type) :: mapin,mapout + integer, intent(out) :: info + + call psb_move_alloc(mapin%itd_data,mapout%itd_data,info) + call psb_move_alloc(mapin%iaggr,mapout%iaggr,info) + call psb_move_alloc(mapin%naggr,mapout%naggr,info) + mapout%p_desc_X => mapin%p_desc_X + mapin%p_desc_X => null() + mapout%p_desc_Y => mapin%p_desc_Y + mapin%p_desc_Y => null() + call psb_move_alloc(mapin%desc_X,mapout%desc_X,info) + call psb_move_alloc(mapin%desc_Y,mapout%desc_Y,info) + call psb_move_alloc(mapin%map_X2Y,mapout%map_X2Y,info) + call psb_move_alloc(mapin%map_Y2X,mapout%map_Y2X,info) + + end subroutine psb_clinmap_transfer + +end module psb_c_linmap_mod + +module psb_z_linmap_mod + + use psb_const_mod + use psb_linmap_type_mod + + + interface psb_map_X2Y + subroutine psb_z_map_X2Y(alpha,x,beta,y,map,info,work) + use psb_linmap_type_mod + implicit none + type(psb_zlinmap_type), intent(in) :: map + complex(psb_dpk_), intent(in) :: alpha,beta + complex(psb_dpk_), intent(inout) :: x(:) + complex(psb_dpk_), intent(out) :: y(:) + integer, intent(out) :: info + complex(psb_dpk_), optional :: work(:) + end subroutine psb_z_map_X2Y + end interface + + interface psb_map_Y2X + subroutine psb_z_map_Y2X(alpha,x,beta,y,map,info,work) + use psb_linmap_type_mod + implicit none + type(psb_zlinmap_type), intent(in) :: map + complex(psb_dpk_), intent(in) :: alpha,beta + complex(psb_dpk_), intent(inout) :: x(:) + complex(psb_dpk_), intent(out) :: y(:) + integer, intent(out) :: info + complex(psb_dpk_), optional :: work(:) + end subroutine psb_z_map_Y2X + end interface + + + interface psb_is_ok_map + module procedure psb_is_ok_zlinmap + end interface + + interface psb_get_map_kind + module procedure psb_get_zmap_kind + end interface + + interface psb_set_map_kind + module procedure psb_set_zmap_kind + end interface - function psb_is_ok_dlinmap(map) result(this) - implicit none - type(psb_dlinmap_type), intent(in) :: map - logical :: this - this = .false. - if (.not.allocated(map%itd_data)) return - select case(psb_get_map_kind(map)) - case (psb_map_aggr_) - if (.not.associated(map%p_desc_X)) return - if (.not.associated(map%p_desc_Y)) return - this = & - & psb_is_ok_desc(map%p_desc_X).and.psb_is_ok_desc(map%p_desc_Y) - case(psb_map_gen_linear_) - this = & - & psb_is_ok_desc(map%desc_X).and.psb_is_ok_desc(map%desc_Y) - end select + interface psb_is_asb_map + module procedure psb_is_asb_zlinmap + end interface - end function psb_is_ok_dlinmap + interface psb_linmap_sub + module procedure psb_z_linmap_sub + end interface - function psb_is_ok_clinmap(map) result(this) + interface psb_move_alloc + module procedure psb_zlinmap_transfer + end interface + + interface psb_linmap + function psb_z_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) + use psb_linmap_type_mod + implicit none + type(psb_zlinmap_type) :: psb_z_linmap + type(psb_desc_type), target :: desc_X, desc_Y + type(psb_z_sparse_mat), intent(in) :: map_X2Y, map_Y2X + integer, intent(in) :: map_kind + integer, intent(in), optional :: iaggr(:), naggr(:) + end function psb_z_linmap + end interface + + interface psb_sizeof + module procedure psb_zlinmap_sizeof + end interface + +contains + + function psb_get_zmap_kind(map) + implicit none + type(psb_zlinmap_type), intent(in) :: map + Integer :: psb_get_zmap_kind + if (allocated(map%itd_data)) then + psb_get_zmap_kind = map%itd_data(psb_map_kind_) + else + psb_get_zmap_kind = -1 + end if + end function psb_get_zmap_kind + + subroutine psb_set_zmap_kind(map_kind,map) + implicit none + integer, intent(in) :: map_kind + type(psb_zlinmap_type), intent(inout) :: map + + map%itd_data(psb_map_kind_) = map_kind + + end subroutine psb_set_zmap_kind + + function psb_is_asb_zlinmap(map) result(this) + use psb_descriptor_type implicit none - type(psb_clinmap_type), intent(in) :: map - logical :: this + type(psb_zlinmap_type), intent(in) :: map + logical :: this + this = .false. if (.not.allocated(map%itd_data)) return select case(psb_get_map_kind(map)) case (psb_map_aggr_) if (.not.associated(map%p_desc_X)) return if (.not.associated(map%p_desc_Y)) return - this = & - & psb_is_ok_desc(map%p_desc_X).and.psb_is_ok_desc(map%p_desc_Y) + this = & + & psb_is_asb_desc(map%p_desc_X).and.psb_is_asb_desc(map%p_desc_Y) + case(psb_map_gen_linear_) + this = & - & psb_is_ok_desc(map%desc_X).and.psb_is_ok_desc(map%desc_Y) + & psb_is_asb_desc(map%desc_X).and.psb_is_asb_desc(map%desc_Y) + end select - end function psb_is_ok_clinmap + end function psb_is_asb_zlinmap function psb_is_ok_zlinmap(map) result(this) + use psb_descriptor_type implicit none type(psb_zlinmap_type), intent(in) :: map logical :: this @@ -449,69 +765,9 @@ contains end function psb_is_ok_zlinmap - - function psb_slinmap_sizeof(map) result(val) - use psb_mat_mod, only : psb_sizeof - implicit none - type(psb_slinmap_type), intent(in) :: map - integer(psb_long_int_k_) :: val - - val = 0 - if (allocated(map%itd_data)) & - & val = val + psb_sizeof_int*size(map%itd_data) - if (allocated(map%iaggr)) & - & val = val + psb_sizeof_int*size(map%iaggr) - if (allocated(map%naggr)) & - & val = val + psb_sizeof_int*size(map%naggr) - val = val + psb_sizeof(map%desc_X) - val = val + psb_sizeof(map%desc_Y) - val = val + psb_sizeof(map%map_X2Y) - val = val + psb_sizeof(map%map_Y2X) - - end function psb_slinmap_sizeof - - function psb_dlinmap_sizeof(map) result(val) - use psb_mat_mod, only : psb_sizeof - implicit none - type(psb_dlinmap_type), intent(in) :: map - integer(psb_long_int_k_) :: val - - val = 0 - if (allocated(map%itd_data)) & - & val = val + psb_sizeof_int*size(map%itd_data) - if (allocated(map%iaggr)) & - & val = val + psb_sizeof_int*size(map%iaggr) - if (allocated(map%naggr)) & - & val = val + psb_sizeof_int*size(map%naggr) - val = val + psb_sizeof(map%desc_X) - val = val + psb_sizeof(map%desc_Y) - val = val + psb_sizeof(map%map_X2Y) - val = val + psb_sizeof(map%map_Y2X) - - end function psb_dlinmap_sizeof - - function psb_clinmap_sizeof(map) result(val) - use psb_mat_mod, only : psb_sizeof - implicit none - type(psb_clinmap_type), intent(in) :: map - integer(psb_long_int_k_) :: val - - val = 0 - if (allocated(map%itd_data)) & - & val = val + psb_sizeof_int*size(map%itd_data) - if (allocated(map%iaggr)) & - & val = val + psb_sizeof_int*size(map%iaggr) - if (allocated(map%naggr)) & - & val = val + psb_sizeof_int*size(map%naggr) - val = val + psb_sizeof(map%desc_X) - val = val + psb_sizeof(map%desc_Y) - val = val + psb_sizeof(map%map_X2Y) - val = val + psb_sizeof(map%map_Y2X) - - end function psb_clinmap_sizeof - function psb_zlinmap_sizeof(map) result(val) use psb_mat_mod, only : psb_sizeof + use psb_descriptor_type implicit none type(psb_zlinmap_type), intent(in) :: map integer(psb_long_int_k_) :: val @@ -530,40 +786,6 @@ contains end function psb_zlinmap_sizeof - - subroutine psb_s_linmap_sub(out_map,map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) - use psb_linmap_type_mod - implicit none - type(psb_slinmap_type), intent(out) :: out_map - type(psb_desc_type), target :: desc_X, desc_Y - type(psb_s_sparse_mat), intent(in) :: map_X2Y, map_Y2X - integer, intent(in) :: map_kind - integer, intent(in), optional :: iaggr(:), naggr(:) - out_map = psb_linmap(map_kind,desc_X,desc_Y,map_X2Y,map_Y2X,iaggr,naggr) - end subroutine psb_s_linmap_sub - - subroutine psb_d_linmap_sub(out_map,map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) - use psb_linmap_type_mod - implicit none - type(psb_dlinmap_type), intent(out) :: out_map - type(psb_desc_type), target :: desc_X, desc_Y - type(psb_d_sparse_mat), intent(in) :: map_X2Y, map_Y2X - integer, intent(in) :: map_kind - integer, intent(in), optional :: iaggr(:), naggr(:) - out_map = psb_linmap(map_kind,desc_X,desc_Y,map_X2Y,map_Y2X,iaggr,naggr) - end subroutine psb_d_linmap_sub - - subroutine psb_c_linmap_sub(out_map,map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) - use psb_linmap_type_mod - implicit none - type(psb_clinmap_type), intent(out) :: out_map - type(psb_desc_type), target :: desc_X, desc_Y - type(psb_c_sparse_mat), intent(in) :: map_X2Y, map_Y2X - integer, intent(in) :: map_kind - integer, intent(in), optional :: iaggr(:), naggr(:) - out_map = psb_linmap(map_kind,desc_X,desc_Y,map_X2Y,map_Y2X,iaggr,naggr) - end subroutine psb_c_linmap_sub - subroutine psb_z_linmap_sub(out_map,map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) use psb_linmap_type_mod implicit none @@ -575,73 +797,6 @@ contains out_map = psb_linmap(map_kind,desc_X,desc_Y,map_X2Y,map_Y2X,iaggr,naggr) end subroutine psb_z_linmap_sub - - subroutine psb_slinmap_transfer(mapin,mapout,info) - use psb_realloc_mod - use psb_descriptor_type - use psb_mat_mod, only : psb_move_alloc - implicit none - type(psb_slinmap_type) :: mapin,mapout - integer, intent(out) :: info - - call psb_move_alloc(mapin%itd_data,mapout%itd_data,info) - call psb_move_alloc(mapin%iaggr,mapout%iaggr,info) - call psb_move_alloc(mapin%naggr,mapout%naggr,info) - mapout%p_desc_X => mapin%p_desc_X - mapin%p_desc_X => null() - mapout%p_desc_Y => mapin%p_desc_Y - mapin%p_desc_Y => null() - call psb_move_alloc(mapin%desc_X,mapout%desc_X,info) - call psb_move_alloc(mapin%desc_Y,mapout%desc_Y,info) - call psb_move_alloc(mapin%map_X2Y,mapout%map_X2Y,info) - call psb_move_alloc(mapin%map_Y2X,mapout%map_Y2X,info) - - end subroutine psb_slinmap_transfer - - subroutine psb_dlinmap_transfer(mapin,mapout,info) - use psb_realloc_mod - use psb_descriptor_type - use psb_mat_mod, only : psb_move_alloc - implicit none - type(psb_dlinmap_type) :: mapin,mapout - integer, intent(out) :: info - - call psb_move_alloc(mapin%itd_data,mapout%itd_data,info) - call psb_move_alloc(mapin%iaggr,mapout%iaggr,info) - call psb_move_alloc(mapin%naggr,mapout%naggr,info) - mapout%p_desc_X => mapin%p_desc_X - mapin%p_desc_X => null() - mapout%p_desc_Y => mapin%p_desc_Y - mapin%p_desc_Y => null() - call psb_move_alloc(mapin%desc_X,mapout%desc_X,info) - call psb_move_alloc(mapin%desc_Y,mapout%desc_Y,info) - call psb_move_alloc(mapin%map_X2Y,mapout%map_X2Y,info) - call psb_move_alloc(mapin%map_Y2X,mapout%map_Y2X,info) - - end subroutine psb_dlinmap_transfer - - subroutine psb_clinmap_transfer(mapin,mapout,info) - use psb_realloc_mod - use psb_mat_mod, only : psb_move_alloc - use psb_descriptor_type - implicit none - type(psb_clinmap_type) :: mapin,mapout - integer, intent(out) :: info - - call psb_move_alloc(mapin%itd_data,mapout%itd_data,info) - call psb_move_alloc(mapin%iaggr,mapout%iaggr,info) - call psb_move_alloc(mapin%naggr,mapout%naggr,info) - mapout%p_desc_X => mapin%p_desc_X - mapin%p_desc_X => null() - mapout%p_desc_Y => mapin%p_desc_Y - mapin%p_desc_Y => null() - call psb_move_alloc(mapin%desc_X,mapout%desc_X,info) - call psb_move_alloc(mapin%desc_Y,mapout%desc_Y,info) - call psb_move_alloc(mapin%map_X2Y,mapout%map_X2Y,info) - call psb_move_alloc(mapin%map_Y2X,mapout%map_Y2X,info) - - end subroutine psb_clinmap_transfer - subroutine psb_zlinmap_transfer(mapin,mapout,info) use psb_realloc_mod use psb_mat_mod, only : psb_move_alloc @@ -665,4 +820,16 @@ contains end subroutine psb_zlinmap_transfer +end module psb_z_linmap_mod + +module psb_linmap_mod + + use psb_const_mod + use psb_descriptor_type + use psb_linmap_type_mod + use psb_s_linmap_mod + use psb_d_linmap_mod + use psb_c_linmap_mod + use psb_z_linmap_mod + end module psb_linmap_mod diff --git a/base/modules/psb_s_tools_mod.f90 b/base/modules/psb_s_tools_mod.f90 index 4683e28b..10eb96b4 100644 --- a/base/modules/psb_s_tools_mod.f90 +++ b/base/modules/psb_s_tools_mod.f90 @@ -34,7 +34,7 @@ Module psb_s_tools_mod interface psb_geall subroutine psb_salloc(x, desc_a, info, n, lb) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ implicit none real(psb_spk_), allocatable, intent(out) :: x(:,:) type(psb_desc_type), intent(in) :: desc_a @@ -42,7 +42,7 @@ Module psb_s_tools_mod integer, optional, intent(in) :: n, lb end subroutine psb_salloc subroutine psb_sallocv(x, desc_a,info,n) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ real(psb_spk_), allocatable, intent(out) :: x(:) type(psb_desc_type), intent(in) :: desc_a integer,intent(out) :: info @@ -53,13 +53,13 @@ Module psb_s_tools_mod interface psb_geasb subroutine psb_sasb(x, desc_a, info) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ type(psb_desc_type), intent(in) :: desc_a real(psb_spk_), allocatable, intent(inout) :: x(:,:) integer, intent(out) :: info end subroutine psb_sasb subroutine psb_sasbv(x, desc_a, info) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ type(psb_desc_type), intent(in) :: desc_a real(psb_spk_), allocatable, intent(inout) :: x(:) integer, intent(out) :: info @@ -69,7 +69,7 @@ Module psb_s_tools_mod interface psb_sphalo Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,& & rowscale,colscale,outfmt,data) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ use psb_mat_mod, only : psb_s_sparse_mat Type(psb_s_sparse_mat),Intent(in) :: a Type(psb_s_sparse_mat),Intent(inout) :: blk @@ -84,13 +84,13 @@ Module psb_s_tools_mod interface psb_gefree subroutine psb_sfree(x, desc_a, info) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ real(psb_spk_),allocatable, intent(inout) :: x(:,:) type(psb_desc_type), intent(in) :: desc_a integer, intent(out) :: info end subroutine psb_sfree subroutine psb_sfreev(x, desc_a, info) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ real(psb_spk_),allocatable, intent(inout) :: x(:) type(psb_desc_type), intent(in) :: desc_a integer, intent(out) :: info @@ -100,7 +100,7 @@ Module psb_s_tools_mod interface psb_geins subroutine psb_sinsi(m,irw,val, x,desc_a,info,dupl) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ integer, intent(in) :: m type(psb_desc_type), intent(in) :: desc_a real(psb_spk_),intent(inout) :: x(:,:) @@ -110,7 +110,7 @@ Module psb_s_tools_mod integer, optional, intent(in) :: dupl end subroutine psb_sinsi subroutine psb_sinsvi(m,irw,val,x,desc_a,info,dupl) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ integer, intent(in) :: m type(psb_desc_type), intent(in) :: desc_a real(psb_spk_),intent(inout) :: x(:) @@ -123,7 +123,7 @@ Module psb_s_tools_mod interface psb_cdbldext Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info,extype) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ Use psb_mat_mod, only : psb_s_sparse_mat integer, intent(in) :: novr Type(psb_s_sparse_mat), Intent(in) :: a @@ -136,7 +136,7 @@ Module psb_s_tools_mod interface psb_spall subroutine psb_sspalloc(a, desc_a, info, nnz) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ use psb_mat_mod, only : psb_s_sparse_mat type(psb_desc_type), intent(inout) :: desc_a type(psb_s_sparse_mat), intent(out) :: a @@ -147,7 +147,7 @@ Module psb_s_tools_mod interface psb_spasb subroutine psb_sspasb(a,desc_a, info, afmt, upd, dupl, mold) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ use psb_mat_mod, only : psb_s_base_sparse_mat, psb_s_sparse_mat type(psb_s_sparse_mat), intent (inout) :: a type(psb_desc_type), intent(in) :: desc_a @@ -160,7 +160,7 @@ Module psb_s_tools_mod interface psb_spfree subroutine psb_sspfree(a, desc_a,info) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ use psb_mat_mod, only : psb_s_sparse_mat type(psb_desc_type), intent(in) :: desc_a type(psb_s_sparse_mat), intent(inout) :: a @@ -171,7 +171,7 @@ Module psb_s_tools_mod interface psb_spins subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ use psb_mat_mod, only : psb_s_sparse_mat type(psb_desc_type), intent(inout) :: desc_a type(psb_s_sparse_mat), intent(inout) :: a @@ -181,7 +181,7 @@ Module psb_s_tools_mod logical, intent(in), optional :: rebuild end subroutine psb_sspins subroutine psb_sspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ use psb_mat_mod, only : psb_s_sparse_mat type(psb_desc_type), intent(in) :: desc_ar type(psb_desc_type), intent(inout) :: desc_ac @@ -195,7 +195,7 @@ Module psb_s_tools_mod interface psb_sprn subroutine psb_ssprn(a, desc_a,info,clear) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ use psb_mat_mod, only : psb_s_sparse_mat type(psb_desc_type), intent(in) :: desc_a type(psb_s_sparse_mat), intent(inout) :: a @@ -204,90 +204,90 @@ Module psb_s_tools_mod end subroutine psb_ssprn end interface - - interface psb_linmap_init - module procedure psb_slinmap_init - end interface - - interface psb_linmap_ins - module procedure psb_slinmap_ins - end interface - - interface psb_linmap_asb - module procedure psb_slinmap_asb - end interface - -contains - - - subroutine psb_slinmap_init(a_map,cd_xt,descin,descout) - use psb_descriptor_type - use psb_serial_mod - use psb_penv_mod - use psb_error_mod - use psb_base_tools_mod - use psb_s_mat_mod - implicit none - type(psb_s_sparse_mat), intent(out) :: a_map - type(psb_desc_type), intent(out) :: cd_xt - type(psb_desc_type), intent(in) :: descin, descout - - integer :: nrow_in, nrow_out, ncol_in, info, ictxt - - ictxt = psb_cd_get_context(descin) - call psb_cdcpy(descin,cd_xt,info) - if (info ==0) call psb_cd_reinit(cd_xt,info) - if (info /= 0) then - write(0,*) 'Error on reinitialising the extension map' - call psb_error(ictxt) - call psb_abort(ictxt) - stop - end if - - nrow_in = psb_cd_get_local_rows(cd_xt) - ncol_in = psb_cd_get_local_cols(cd_xt) - nrow_out = psb_cd_get_local_rows(descout) - - call a_map%csall(nrow_out,ncol_in,info) - - end subroutine psb_slinmap_init - - subroutine psb_slinmap_ins(nz,ir,ic,val,a_map,cd_xt,descin,descout) - use psb_s_mat_mod - use psb_descriptor_type - implicit none - integer, intent(in) :: nz - integer, intent(in) :: ir(:),ic(:) - real(psb_spk_), intent(in) :: val(:) - type(psb_s_sparse_mat), intent(inout) :: a_map - type(psb_desc_type), intent(inout) :: cd_xt - type(psb_desc_type), intent(in) :: descin, descout - integer :: info - call psb_spins(nz,ir,ic,val,a_map,descout,cd_xt,info) - - end subroutine psb_slinmap_ins - - subroutine psb_slinmap_asb(a_map,cd_xt,descin,descout,afmt) - use psb_base_tools_mod - use psb_s_mat_mod - use psb_descriptor_type - use psb_serial_mod - implicit none - type(psb_s_sparse_mat), intent(inout) :: a_map - type(psb_desc_type), intent(inout) :: cd_xt - type(psb_desc_type), intent(in) :: descin, descout - character(len=*), optional, intent(in) :: afmt - - - integer :: nrow_in, nrow_out, ncol_in, info, ictxt - - ictxt = psb_cd_get_context(descin) - - call psb_cdasb(cd_xt,info) - call a_map%set_ncols(psb_cd_get_local_cols(cd_xt)) - call a_map%cscnv(info,type=afmt) - - end subroutine psb_slinmap_asb +!!$ +!!$ interface psb_linmap_init +!!$ module procedure psb_slinmap_init +!!$ end interface +!!$ +!!$ interface psb_linmap_ins +!!$ module procedure psb_slinmap_ins +!!$ end interface +!!$ +!!$ interface psb_linmap_asb +!!$ module procedure psb_slinmap_asb +!!$ end interface +!!$ +!!$contains +!!$ +!!$ +!!$ subroutine psb_slinmap_init(a_map,cd_xt,descin,descout) +!!$ use psb_descriptor_type +!!$ use psb_serial_mod +!!$ use psb_penv_mod +!!$ use psb_error_mod +!!$ use psb_base_tools_mod +!!$ use psb_s_mat_mod +!!$ implicit none +!!$ type(psb_s_sparse_mat), intent(out) :: a_map +!!$ type(psb_desc_type), intent(out) :: cd_xt +!!$ type(psb_desc_type), intent(in) :: descin, descout +!!$ +!!$ integer :: nrow_in, nrow_out, ncol_in, info, ictxt +!!$ +!!$ ictxt = psb_cd_get_context(descin) +!!$ call psb_cdcpy(descin,cd_xt,info) +!!$ if (info ==0) call psb_cd_reinit(cd_xt,info) +!!$ if (info /= 0) then +!!$ write(0,*) 'Error on reinitialising the extension map' +!!$ call psb_error(ictxt) +!!$ call psb_abort(ictxt) +!!$ stop +!!$ end if +!!$ +!!$ nrow_in = psb_cd_get_local_rows(cd_xt) +!!$ ncol_in = psb_cd_get_local_cols(cd_xt) +!!$ nrow_out = psb_cd_get_local_rows(descout) +!!$ +!!$ call a_map%csall(nrow_out,ncol_in,info) +!!$ +!!$ end subroutine psb_slinmap_init +!!$ +!!$ subroutine psb_slinmap_ins(nz,ir,ic,val,a_map,cd_xt,descin,descout) +!!$ use psb_s_mat_mod +!!$ use psb_descriptor_type +!!$ implicit none +!!$ integer, intent(in) :: nz +!!$ integer, intent(in) :: ir(:),ic(:) +!!$ real(psb_spk_), intent(in) :: val(:) +!!$ type(psb_s_sparse_mat), intent(inout) :: a_map +!!$ type(psb_desc_type), intent(inout) :: cd_xt +!!$ type(psb_desc_type), intent(in) :: descin, descout +!!$ integer :: info +!!$ call psb_spins(nz,ir,ic,val,a_map,descout,cd_xt,info) +!!$ +!!$ end subroutine psb_slinmap_ins +!!$ +!!$ subroutine psb_slinmap_asb(a_map,cd_xt,descin,descout,afmt) +!!$ use psb_base_tools_mod +!!$ use psb_s_mat_mod +!!$ use psb_descriptor_type +!!$ use psb_serial_mod +!!$ implicit none +!!$ type(psb_s_sparse_mat), intent(inout) :: a_map +!!$ type(psb_desc_type), intent(inout) :: cd_xt +!!$ type(psb_desc_type), intent(in) :: descin, descout +!!$ character(len=*), optional, intent(in) :: afmt +!!$ +!!$ +!!$ integer :: nrow_in, nrow_out, ncol_in, info, ictxt +!!$ +!!$ ictxt = psb_cd_get_context(descin) +!!$ +!!$ call psb_cdasb(cd_xt,info) +!!$ call a_map%set_ncols(psb_cd_get_local_cols(cd_xt)) +!!$ call a_map%cscnv(info,type=afmt) +!!$ +!!$ end subroutine psb_slinmap_asb end module psb_s_tools_mod diff --git a/base/modules/psb_z_tools_mod.f90 b/base/modules/psb_z_tools_mod.f90 index 087f05c7..7234cd02 100644 --- a/base/modules/psb_z_tools_mod.f90 +++ b/base/modules/psb_z_tools_mod.f90 @@ -33,7 +33,7 @@ Module psb_z_tools_mod interface psb_geall subroutine psb_zalloc(x, desc_a, info, n, lb) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ implicit none complex(psb_dpk_), allocatable, intent(out) :: x(:,:) type(psb_desc_type), intent(in) :: desc_a @@ -41,7 +41,7 @@ Module psb_z_tools_mod integer, optional, intent(in) :: n, lb end subroutine psb_zalloc subroutine psb_zallocv(x, desc_a,info,n) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ complex(psb_dpk_), allocatable, intent(out) :: x(:) type(psb_desc_type), intent(in) :: desc_a integer, intent(out) :: info @@ -52,13 +52,13 @@ Module psb_z_tools_mod interface psb_geasb subroutine psb_zasb(x, desc_a, info) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ type(psb_desc_type), intent(in) :: desc_a complex(psb_dpk_), allocatable, intent(inout) :: x(:,:) integer, intent(out) :: info end subroutine psb_zasb subroutine psb_zasbv(x, desc_a, info) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ type(psb_desc_type), intent(in) :: desc_a complex(psb_dpk_), allocatable, intent(inout) :: x(:) integer, intent(out) :: info @@ -68,7 +68,7 @@ Module psb_z_tools_mod interface psb_sphalo Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,& & rowscale,colscale,outfmt,data) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ use psb_mat_mod, only : psb_z_sparse_mat Type(psb_z_sparse_mat),Intent(in) :: a Type(psb_z_sparse_mat),Intent(inout) :: blk @@ -82,13 +82,13 @@ Module psb_z_tools_mod interface psb_gefree subroutine psb_zfree(x, desc_a, info) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ complex(psb_dpk_),allocatable, intent(inout) :: x(:,:) type(psb_desc_type), intent(in) :: desc_a integer, intent(out) :: info end subroutine psb_zfree subroutine psb_zfreev(x, desc_a, info) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ complex(psb_dpk_),allocatable, intent(inout) :: x(:) type(psb_desc_type), intent(in) :: desc_a integer, intent(out) :: info @@ -98,7 +98,7 @@ Module psb_z_tools_mod interface psb_geins subroutine psb_zinsi(m,irw,val, x, desc_a,info,dupl) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ integer, intent(in) :: m type(psb_desc_type), intent(in) :: desc_a complex(psb_dpk_),intent(inout) :: x(:,:) @@ -108,7 +108,7 @@ Module psb_z_tools_mod integer, optional, intent(in) :: dupl end subroutine psb_zinsi subroutine psb_zinsvi(m, irw,val, x,desc_a,info,dupl) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ integer, intent(in) :: m type(psb_desc_type), intent(in) :: desc_a complex(psb_dpk_),intent(inout) :: x(:) @@ -123,7 +123,7 @@ Module psb_z_tools_mod interface psb_cdbldext Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info,extype) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ Use psb_mat_mod, only : psb_z_sparse_mat integer, intent(in) :: novr Type(psb_z_sparse_mat), Intent(in) :: a @@ -136,7 +136,7 @@ Module psb_z_tools_mod interface psb_spall subroutine psb_zspalloc(a, desc_a, info, nnz) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ use psb_mat_mod, only : psb_z_sparse_mat type(psb_desc_type), intent(inout) :: desc_a type(psb_z_sparse_mat), intent(out) :: a @@ -147,7 +147,7 @@ Module psb_z_tools_mod interface psb_spasb subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl,mold) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ use psb_mat_mod, only : psb_z_sparse_mat, psb_z_base_sparse_mat type(psb_z_sparse_mat), intent (inout) :: a type(psb_desc_type), intent(in) :: desc_a @@ -160,7 +160,7 @@ Module psb_z_tools_mod interface psb_spfree subroutine psb_zspfree(a, desc_a,info) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ use psb_mat_mod, only : psb_z_sparse_mat type(psb_desc_type), intent(in) :: desc_a type(psb_z_sparse_mat), intent(inout) ::a @@ -171,7 +171,7 @@ Module psb_z_tools_mod interface psb_spins subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ use psb_mat_mod, only : psb_z_sparse_mat type(psb_desc_type), intent(inout) :: desc_a type(psb_z_sparse_mat), intent(inout) :: a @@ -181,7 +181,7 @@ Module psb_z_tools_mod logical, intent(in), optional :: rebuild end subroutine psb_zspins subroutine psb_zspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ use psb_mat_mod, only : psb_z_sparse_mat type(psb_desc_type), intent(in) :: desc_ar type(psb_desc_type), intent(inout) :: desc_ac @@ -195,7 +195,7 @@ Module psb_z_tools_mod interface psb_sprn subroutine psb_zsprn(a, desc_a,info,clear) - use psb_descriptor_type + use psb_descriptor_type, only : psb_desc_type, psb_spk_, psb_dpk_ use psb_mat_mod, only : psb_z_sparse_mat type(psb_desc_type), intent(in) :: desc_a type(psb_z_sparse_mat), intent(inout) :: a @@ -205,90 +205,90 @@ Module psb_z_tools_mod end interface - interface psb_linmap_init - module procedure psb_zlinmap_init - end interface - - interface psb_linmap_ins - module procedure psb_zlinmap_ins - end interface - - interface psb_linmap_asb - module procedure psb_zlinmap_asb - end interface - -contains - - - subroutine psb_zlinmap_init(a_map,cd_xt,descin,descout) - use psb_base_tools_mod - use psb_z_mat_mod - use psb_descriptor_type - use psb_serial_mod - use psb_penv_mod - use psb_error_mod - implicit none - type(psb_z_sparse_mat), intent(out) :: a_map - type(psb_desc_type), intent(out) :: cd_xt - type(psb_desc_type), intent(in) :: descin, descout - - integer :: nrow_in, nrow_out, ncol_in, info, ictxt - - ictxt = psb_cd_get_context(descin) - - call psb_cdcpy(descin,cd_xt,info) - if (info ==0) call psb_cd_reinit(cd_xt,info) - if (info /= 0) then - write(0,*) 'Error on reinitialising the extension map' - call psb_error(ictxt) - call psb_abort(ictxt) - stop - end if - - nrow_in = psb_cd_get_local_rows(cd_xt) - ncol_in = psb_cd_get_local_cols(cd_xt) - nrow_out = psb_cd_get_local_rows(descout) - - call a_map%csall(nrow_out,ncol_in,info) - - end subroutine psb_zlinmap_init - - subroutine psb_zlinmap_ins(nz,ir,ic,val,a_map,cd_xt,descin,descout) - use psb_base_tools_mod - use psb_z_mat_mod - use psb_descriptor_type - implicit none - integer, intent(in) :: nz - integer, intent(in) :: ir(:),ic(:) - complex(psb_dpk_), intent(in) :: val(:) - type(psb_z_sparse_mat), intent(inout) :: a_map - type(psb_desc_type), intent(inout) :: cd_xt - type(psb_desc_type), intent(in) :: descin, descout - integer :: info - - call psb_spins(nz,ir,ic,val,a_map,descout,cd_xt,info) - - end subroutine psb_zlinmap_ins - - subroutine psb_zlinmap_asb(a_map,cd_xt,descin,descout,afmt) - use psb_base_tools_mod - use psb_z_mat_mod - use psb_descriptor_type - use psb_serial_mod - implicit none - type(psb_z_sparse_mat), intent(inout) :: a_map - type(psb_desc_type), intent(inout) :: cd_xt - type(psb_desc_type), intent(in) :: descin, descout - character(len=*), optional, intent(in) :: afmt - - integer :: nrow_in, nrow_out, ncol_in, info, ictxt - - ictxt = psb_cd_get_context(descin) - - call psb_cdasb(cd_xt,info) - call a_map%set_ncols(psb_cd_get_local_cols(cd_xt)) - call a_map%cscnv(info,type=afmt) - - end subroutine psb_zlinmap_asb +!!$ interface psb_linmap_init +!!$ module procedure psb_zlinmap_init +!!$ end interface +!!$ +!!$ interface psb_linmap_ins +!!$ module procedure psb_zlinmap_ins +!!$ end interface +!!$ +!!$ interface psb_linmap_asb +!!$ module procedure psb_zlinmap_asb +!!$ end interface +!!$ +!!$contains +!!$ +!!$ +!!$ subroutine psb_zlinmap_init(a_map,cd_xt,descin,descout) +!!$ use psb_base_tools_mod +!!$ use psb_z_mat_mod +!!$ use psb_descriptor_type +!!$ use psb_serial_mod +!!$ use psb_penv_mod +!!$ use psb_error_mod +!!$ implicit none +!!$ type(psb_z_sparse_mat), intent(out) :: a_map +!!$ type(psb_desc_type), intent(out) :: cd_xt +!!$ type(psb_desc_type), intent(in) :: descin, descout +!!$ +!!$ integer :: nrow_in, nrow_out, ncol_in, info, ictxt +!!$ +!!$ ictxt = psb_cd_get_context(descin) +!!$ +!!$ call psb_cdcpy(descin,cd_xt,info) +!!$ if (info ==0) call psb_cd_reinit(cd_xt,info) +!!$ if (info /= 0) then +!!$ write(0,*) 'Error on reinitialising the extension map' +!!$ call psb_error(ictxt) +!!$ call psb_abort(ictxt) +!!$ stop +!!$ end if +!!$ +!!$ nrow_in = psb_cd_get_local_rows(cd_xt) +!!$ ncol_in = psb_cd_get_local_cols(cd_xt) +!!$ nrow_out = psb_cd_get_local_rows(descout) +!!$ +!!$ call a_map%csall(nrow_out,ncol_in,info) +!!$ +!!$ end subroutine psb_zlinmap_init +!!$ +!!$ subroutine psb_zlinmap_ins(nz,ir,ic,val,a_map,cd_xt,descin,descout) +!!$ use psb_base_tools_mod +!!$ use psb_z_mat_mod +!!$ use psb_descriptor_type +!!$ implicit none +!!$ integer, intent(in) :: nz +!!$ integer, intent(in) :: ir(:),ic(:) +!!$ complex(psb_dpk_), intent(in) :: val(:) +!!$ type(psb_z_sparse_mat), intent(inout) :: a_map +!!$ type(psb_desc_type), intent(inout) :: cd_xt +!!$ type(psb_desc_type), intent(in) :: descin, descout +!!$ integer :: info +!!$ +!!$ call psb_spins(nz,ir,ic,val,a_map,descout,cd_xt,info) +!!$ +!!$ end subroutine psb_zlinmap_ins +!!$ +!!$ subroutine psb_zlinmap_asb(a_map,cd_xt,descin,descout,afmt) +!!$ use psb_base_tools_mod +!!$ use psb_z_mat_mod +!!$ use psb_descriptor_type +!!$ use psb_serial_mod +!!$ implicit none +!!$ type(psb_z_sparse_mat), intent(inout) :: a_map +!!$ type(psb_desc_type), intent(inout) :: cd_xt +!!$ type(psb_desc_type), intent(in) :: descin, descout +!!$ character(len=*), optional, intent(in) :: afmt +!!$ +!!$ integer :: nrow_in, nrow_out, ncol_in, info, ictxt +!!$ +!!$ ictxt = psb_cd_get_context(descin) +!!$ +!!$ call psb_cdasb(cd_xt,info) +!!$ call a_map%set_ncols(psb_cd_get_local_cols(cd_xt)) +!!$ call a_map%cscnv(info,type=afmt) +!!$ +!!$ end subroutine psb_zlinmap_asb end module psb_z_tools_mod diff --git a/base/tools/Makefile b/base/tools/Makefile index 6196e9de..c53203cd 100644 --- a/base/tools/Makefile +++ b/base/tools/Makefile @@ -18,7 +18,8 @@ FOBJS = psb_sallc.o psb_sasb.o \ psb_zspins.o psb_zsprn.o \ psb_cspalloc.o psb_cspasb.o psb_cspfree.o\ psb_callc.o psb_casb.o psb_cfree.o psb_cins.o \ - psb_cspins.o psb_csprn.o psb_map.o psb_cd_set_bld.o psb_linmap.o + psb_cspins.o psb_csprn.o psb_cd_set_bld.o +#psb_linmap.o psb_map.o MPFOBJS = psb_ssphalo.o psb_csphalo.o psb_dsphalo.o psb_zsphalo.o psb_icdasb.o \ psb_dcdbldext.o psb_zcdbldext.o psb_scdbldext.o psb_ccdbldext.o diff --git a/configure.ac b/configure.ac index bae3c88b..028abd49 100755 --- a/configure.ac +++ b/configure.ac @@ -362,7 +362,7 @@ if test "X$CCOPT" == "X" ; then CCOPT="-O2 $CCOPT" fi fi -CFLAGS="${CCOPT}" +#CFLAGS="${CCOPT}" if test "X$FCOPT" == "X" ; then if test "X$psblas_cv_fc" == "Xgcc" ; then @@ -371,7 +371,7 @@ if test "X$FCOPT" == "X" ; then FCOPT="-O3 $FCOPT" elif test "X$psblas_cv_fc" == X"xlf" ; then # XL compiler : consider using -qarch=auto - FCOPT="-O3 -qarch=auto $FCOPT" + FCOPT="-O3 -qarch=auto -qfixed -qsuffix=f=f:cpp=F $FCOPT" elif test "X$psblas_cv_fc" == X"ifc" ; then # other compilers .. FCOPT="-O3 $FCOPT" @@ -394,7 +394,7 @@ if test "X$psblas_cv_fc" == X"nag" ; then # Add needed options FCOPT="$FCOPT -dcfuns -f2003 -wmismatch=mpi_scatterv,mpi_alltoallv,mpi_gatherv,mpi_allgatherv" fi -FFLAGS="${FCOPT}" +#FFLAGS="${FCOPT}" if test "X$F90COPT" == "X" ; then if test "X$psblas_cv_fc" == "Xgcc" ; then @@ -403,7 +403,7 @@ if test "X$F90COPT" == "X" ; then F90COPT="-O3 $F90COPT" elif test "X$psblas_cv_fc" == X"xlf" ; then # XL compiler : consider using -qarch=auto - F90COPT="-O3 -qarch=auto $F90COPT" + F90COPT="-O3 -qarch=auto -qsuffix=f=f90:cpp=F90 $F90COPT" elif test "X$psblas_cv_fc" == X"ifc" ; then # other compilers .. F90COPT="-O3 $F90COPT" @@ -428,59 +428,30 @@ if test "X$psblas_cv_fc" == X"nag" ; then F90COPT="$F90COPT -dcfuns -f2003 -wmismatch=mpi_scatterv,mpi_alltoallv,mpi_gatherv,mpi_allgatherv" EXTRA_OPT="-mismatch_all" F03COPT="${F90COPT}" + F03="nagfor" +elif test "X$psblas_cv_fc" == X"xlf" ; then + F03="xlf2003_r" + F03COPT="-O3 -qarch=auto -qsuffix=f=f03:cpp=F03 $F03COPT" else + F03=${FC} F03COPT="${F90COPT}" fi -FCFLAGS="${F90COPT}" +#FCFLAGS="${F90COPT}" # COPT,FCOPT, F90COPT are aliases for FFLAGS,CFLAGS,FCFLAGS . ############################################################################## # Compilers variables selection ############################################################################## -if test "X$psblas_cv_fc" == X"xlf" ; then - # WARNING : this is EVIL : specifying a pathname prefixed compiler will be ignored! - # But this is necessary since : - # - if called from some script, xlf could behave strangely - # - it is not said that mpxlf95 gets chosen by the configure script. - F90="xlf95 -qsuffix=f=f90:cpp=F90" - F03="xlf2003_r -qsuffix=f=f03:cpp=F03" - # F90="xlf95" -# FC="xlf" - -# Note : this gives problems in base/serial/aux/isaperm.f -# FC="mpxlf -qsuffix=f=f90:cpp=F90" - -# Note : this is the cure - FC="xlf -qsuffix=f=f:cpp=F" - # Note : maybe we will want xlf -qsuffix=cpp=F - F77="xlf" - CC="xlc" - if test x"$pac_cv_serial_mpi" == x"yes" ; then - MPF90="xlf2003_r -qsuffix=f=f90:cpp=F90" - MPF77="xlf95 -qfixed -qsuffix=f=f:cpp=F" - MPCC="xlc" - else - MPF90="mpxlf2003_r -qsuffix=f=f90:cpp=F90" - MPF77="mpxlf95 -qfixed -qsuffix=f=f:cpp=F" - MPCC="mpcc" - fi - #MPFCC="mpxlc" - # Note : -qfixed should be not specified in the environment FFLAGS or things will break. - # This fact should be documented somewhere. -else - # We really think about the GCC here but this is our idea for other compilers, too. - # If the user wishes to, she should specify MPICC, MPIF77 after ./configure. - # Note: this behavious should be documented. - F90=${FC} - F03=${FC} - MPF90=${MPIFC} - FC=${FC} - MPF77=${MPIFC} - CC=${CC} - MPCC=${MPICC} -fi +F90=${FC} +F03=${F03} +MPF90=${MPIFC} +FC=${FC} +MPF77=${MPIFC} +CC=${CC} +MPCC=${MPICC} + ##############################################################################