fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-20 04:42:08 +00:00
Code Issues Packages Projects Releases Wiki Activity

Rebuild I2 supprot

Browse Source
This commit is contained in:
sfilippone
2026-03-24 15:42:12 +01:00
parent 80c02af47a
commit a223c7eaf3
39 changed files with 7925 additions and 163 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/comm/Makefile
+2 -1
View File
@@ -8,6 +8,7 @@ OBJS = psb_dgather.o psb_dhalo.o psb_dovrl.o \
psb_zgather.o psb_zhalo.o psb_zovrl.o \
psb_dgather_a.o psb_dhalo_a.o psb_dovrl_a.o \
psb_sgather_a.o psb_shalo_a.o psb_sovrl_a.o \
psb_i2gather_a.o psb_i2halo_a.o psb_i2ovrl_a.o \
psb_mgather_a.o psb_mhalo_a.o psb_movrl_a.o \
psb_egather_a.o psb_ehalo_a.o psb_eovrl_a.o \
psb_cgather_a.o psb_chalo_a.o psb_covrl_a.o \
@@ -18,7 +19,7 @@ MPFOBJS=psb_dscatter.o psb_zscatter.o \
psb_iscatter.o psb_lscatter.o \
psb_cscatter.o psb_sscatter.o \
psb_dscatter_a.o psb_zscatter_a.o \
psb_mscatter_a.o psb_escatter_a.o \
psb_mscatter_a.o psb_escatter_a.o psb_i2scatter_a.o \
psb_cscatter_a.o psb_sscatter_a.o \
psb_dspgather.o psb_sspgather.o \
psb_zspgather.o psb_cspgather.o
base/comm/internals/Makefile
+2
View File
@@ -6,6 +6,7 @@ FOBJS = psi_iovrl_restr.o psi_iovrl_save.o psi_iovrl_upd.o \
psi_dovrl_restr.o psi_dovrl_save.o psi_dovrl_upd.o \
psi_covrl_restr.o psi_covrl_save.o psi_covrl_upd.o \
psi_zovrl_restr.o psi_zovrl_save.o psi_zovrl_upd.o \
psi_i2ovrl_restr_a.o psi_i2ovrl_save_a.o psi_i2ovrl_upd_a.o \
psi_movrl_restr_a.o psi_movrl_save_a.o psi_movrl_upd_a.o \
psi_eovrl_restr_a.o psi_eovrl_save_a.o psi_eovrl_upd_a.o \
psi_sovrl_restr_a.o psi_sovrl_save_a.o psi_sovrl_upd_a.o \
@@ -21,6 +22,7 @@ MPFOBJS = psi_dswapdata.o psi_dswaptran.o\
psi_zswapdata.o psi_zswaptran.o \
psi_dswapdata_a.o psi_dswaptran_a.o \
psi_sswapdata_a.o psi_sswaptran_a.o \
psi_i2swapdata_a.o psi_i2swaptran_a.o \
psi_mswapdata_a.o psi_mswaptran_a.o \
psi_eswapdata_a.o psi_eswaptran_a.o \
psi_cswapdata_a.o psi_cswaptran_a.o \
base/modules/Makefile
+43 -18
View File
@@ -28,6 +28,7 @@ COMMINT= penv/psi_penv_mod.o \
SERIAL_MODS=serial/psb_s_serial_mod.o serial/psb_d_serial_mod.o \
serial/psb_c_serial_mod.o serial/psb_z_serial_mod.o \
serial/psb_serial_mod.o \
serial/psb_i2_base_vect_mod.o serial/psb_i2_vect_mod.o\
serial/psb_i_base_vect_mod.o serial/psb_i_vect_mod.o\
serial/psb_l_base_vect_mod.o serial/psb_l_vect_mod.o\
serial/psb_d_base_vect_mod.o serial/psb_d_vect_mod.o\
@@ -35,15 +36,19 @@ SERIAL_MODS=serial/psb_s_serial_mod.o serial/psb_d_serial_mod.o \
serial/psb_c_base_vect_mod.o serial/psb_c_vect_mod.o\
serial/psb_z_base_vect_mod.o serial/psb_z_vect_mod.o\
serial/psb_vect_mod.o\
auxil/psi_serial_mod.o auxil/psi_m_serial_mod.o auxil/psi_e_serial_mod.o \
auxil/psi_serial_mod.o \
auxil/psi_i2_serial_mod.o auxil/psi_m_serial_mod.o auxil/psi_e_serial_mod.o \
auxil/psi_s_serial_mod.o auxil/psi_d_serial_mod.o \
auxil/psi_c_serial_mod.o auxil/psi_z_serial_mod.o \
psi_mod.o psi_i_mod.o psi_l_mod.o psi_s_mod.o psi_d_mod.o psi_c_mod.o psi_z_mod.o\
psi_mod.o psi_i2_mod.o psi_i_mod.o psi_l_mod.o psi_s_mod.o psi_d_mod.o psi_c_mod.o psi_z_mod.o\
auxil/psb_ip_reord_mod.o\
auxil/psi_acx_mod.o auxil/psi_alcx_mod.o auxil/psi_lcx_mod.o \
auxil/psb_i2_ip_reord_mod.o \
auxil/psb_m_ip_reord_mod.o auxil/psb_e_ip_reord_mod.o \
auxil/psb_s_ip_reord_mod.o auxil/psb_d_ip_reord_mod.o \
auxil/psb_c_ip_reord_mod.o auxil/psb_z_ip_reord_mod.o \
auxil/psb_i2_hsort_mod.o auxil/psb_i2_isort_mod.o \
auxil/psb_i2_msort_mod.o auxil/psb_i2_qsort_mod.o \
auxil/psb_m_hsort_mod.o auxil/psb_m_isort_mod.o \
auxil/psb_m_msort_mod.o auxil/psb_m_qsort_mod.o \
auxil/psb_e_hsort_mod.o auxil/psb_e_isort_mod.o \
@@ -56,6 +61,7 @@ SERIAL_MODS=serial/psb_s_serial_mod.o serial/psb_d_serial_mod.o \
auxil/psb_c_msort_mod.o auxil/psb_c_qsort_mod.o \
auxil/psb_z_hsort_mod.o auxil/psb_z_isort_mod.o \
auxil/psb_z_msort_mod.o auxil/psb_z_qsort_mod.o \
auxil/psb_i2_hsort_x_mod.o \
auxil/psb_i_hsort_x_mod.o \
auxil/psb_l_hsort_x_mod.o \
auxil/psb_s_hsort_x_mod.o \
@@ -85,7 +91,7 @@ UTIL_MODS = desc/psb_desc_const_mod.o desc/psb_indx_map_mod.o\
tools/psb_i_tools_mod.o tools/psb_l_tools_mod.o \
tools/psb_s_tools_mod.o tools/psb_d_tools_mod.o\
tools/psb_c_tools_mod.o tools/psb_z_tools_mod.o \
tools/psb_m_tools_a_mod.o tools/psb_e_tools_a_mod.o \
tools/psb_i2_tools_a_mod.o tools/psb_m_tools_a_mod.o tools/psb_e_tools_a_mod.o \
tools/psb_s_tools_a_mod.o tools/psb_d_tools_a_mod.o\
tools/psb_c_tools_a_mod.o tools/psb_z_tools_a_mod.o \
tools/psb_tools_mod.o \
@@ -101,7 +107,7 @@ UTIL_MODS = desc/psb_desc_const_mod.o desc/psb_indx_map_mod.o\
comm/psb_s_comm_a_mod.o comm/psb_d_comm_a_mod.o\
comm/psb_c_comm_a_mod.o comm/psb_z_comm_a_mod.o \
comm/psi_e_comm_a_mod.o comm/psi_m_comm_a_mod.o \
comm/psi_i2_comm_a_mod.o \
comm/psi_i2_comm_a_mod.o comm/psi_i2_comm_v_mod.o \
comm/psi_s_comm_a_mod.o comm/psi_d_comm_a_mod.o \
comm/psi_c_comm_a_mod.o comm/psi_z_comm_a_mod.o \
comm/psi_i_comm_v_mod.o comm/psi_l_comm_v_mod.o \
@@ -136,6 +142,7 @@ $(LIBDIR)/$(LIBNAME): objs
$(OBJS): $(MODULES)
psb_error_mod.o: psb_const_mod.o
psb_realloc_mod.o \
auxil/psb_i2_realloc_mod.o \
auxil/psb_m_realloc_mod.o \
auxil/psb_e_realloc_mod.o \
auxil/psb_s_realloc_mod.o \
@@ -148,6 +155,7 @@ penv/psi_collective_mod.o penv/psi_p2p_mod.o: penv/psi_penv_mod.o
psb_realloc_mod.o: auxil/psb_m_realloc_mod.o \
auxil/psb_e_realloc_mod.o \
auxil/psb_i2_realloc_mod.o \
auxil/psb_s_realloc_mod.o \
auxil/psb_d_realloc_mod.o \
auxil/psb_c_realloc_mod.o \
@@ -178,7 +186,8 @@ penv/psi_d_collective_mod.o penv/psi_c_collective_mod.o penv/psi_z_collective_m
auxil/psi_acx_mod.o auxil/psi_alcx_mod.o auxil/psi_lcx_mod.o \
auxil/psb_string_mod.o auxil/psb_m_realloc_mod.o auxil/psb_e_realloc_mod.o auxil/psb_s_realloc_mod.o \
auxil/psb_string_mod.o auxil/psb_i2_realloc_mod.o auxil/psb_m_realloc_mod.o auxil/psb_e_realloc_mod.o \
auxil/psb_s_realloc_mod.o \
auxil/psb_d_realloc_mod.o auxil/psb_c_realloc_mod.o auxil/psb_z_realloc_mod.o \
desc/psb_desc_const_mod.o psi_penv_mod.o: psb_const_mod.o
@@ -192,6 +201,8 @@ auxil/psb_sort_mod.o: auxil/psb_m_hsort_mod.o auxil/psb_m_isort_mod.o \
auxil/psb_m_msort_mod.o auxil/psb_m_qsort_mod.o \
auxil/psb_e_hsort_mod.o auxil/psb_e_isort_mod.o \
auxil/psb_e_msort_mod.o auxil/psb_e_qsort_mod.o \
auxil/psb_i2_hsort_mod.o auxil/psb_i2_isort_mod.o \
auxil/psb_i2_msort_mod.o auxil/psb_i2_qsort_mod.o \
auxil/psb_s_hsort_mod.o auxil/psb_s_isort_mod.o \
auxil/psb_s_msort_mod.o auxil/psb_s_qsort_mod.o \
auxil/psb_d_hsort_mod.o auxil/psb_d_isort_mod.o \
@@ -200,6 +211,7 @@ auxil/psb_sort_mod.o: auxil/psb_m_hsort_mod.o auxil/psb_m_isort_mod.o \
auxil/psb_c_msort_mod.o auxil/psb_c_qsort_mod.o \
auxil/psb_z_hsort_mod.o auxil/psb_z_isort_mod.o \
auxil/psb_z_msort_mod.o auxil/psb_z_qsort_mod.o \
auxil/psb_i2_hsort_x_mod.o \
auxil/psb_i_hsort_x_mod.o \
auxil/psb_l_hsort_x_mod.o \
auxil/psb_s_hsort_x_mod.o \
@@ -213,6 +225,8 @@ auxil/psb_m_hsort_mod.o auxil/psb_m_isort_mod.o \
auxil/psb_m_msort_mod.o auxil/psb_m_qsort_mod.o \
auxil/psb_e_hsort_mod.o auxil/psb_e_isort_mod.o \
auxil/psb_e_msort_mod.o auxil/psb_e_qsort_mod.o \
auxil/psb_i2_hsort_mod.o auxil/psb_i2_isort_mod.o \
auxil/psb_i2_msort_mod.o auxil/psb_i2_qsort_mod.o \
auxil/psb_s_hsort_mod.o auxil/psb_s_isort_mod.o \
auxil/psb_s_msort_mod.o auxil/psb_s_qsort_mod.o \
auxil/psb_d_hsort_mod.o auxil/psb_d_isort_mod.o \
@@ -221,17 +235,19 @@ auxil/psb_c_hsort_mod.o auxil/psb_c_isort_mod.o \
auxil/psb_c_msort_mod.o auxil/psb_c_qsort_mod.o \
auxil/psb_z_hsort_mod.o auxil/psb_z_isort_mod.o \
auxil/psb_z_msort_mod.o auxil/psb_z_qsort_mod.o \
auxil/psb_i2_hsort_x_mod.o \
auxil/psb_i_hsort_x_mod.o \
auxil/psb_l_hsort_x_mod.o \
auxil/psb_s_hsort_x_mod.o \
auxil/psb_d_hsort_x_mod.o \
auxil/psb_c_hsort_x_mod.o \
auxil/psb_z_hsort_x_mod.o \
auxil/psb_m_ip_reord_mod.o auxil/psb_e_ip_reord_mod.o \
auxil/psb_i2_ip_reord_mod.o auxil/psb_m_ip_reord_mod.o auxil/psb_e_ip_reord_mod.o \
auxil/psb_s_ip_reord_mod.o auxil/psb_d_ip_reord_mod.o \
auxil/psb_c_ip_reord_mod.o auxil/psb_z_ip_reord_mod.o : psb_realloc_mod.o psb_const_mod.o
auxil/psb_i_hsort_x_mod.o: auxil/psb_m_hsort_mod.o auxil/psb_e_hsort_mod.o auxil/psb_i2_hsort_mod.o
auxil/psb_i_hsort_x_mod.o: auxil/psb_m_hsort_mod.o auxil/psb_e_hsort_mod.o
auxil/psb_l_hsort_x_mod.o: auxil/psb_m_hsort_mod.o auxil/psb_e_hsort_mod.o
auxil/psb_s_hsort_x_mod.o: auxil/psb_s_hsort_mod.o
@@ -239,14 +255,14 @@ auxil/psb_d_hsort_x_mod.o: auxil/psb_d_hsort_mod.o
auxil/psb_c_hsort_x_mod.o: auxil/psb_c_hsort_mod.o
auxil/psb_z_hsort_x_mod.o: auxil/psb_z_hsort_mod.o
auxil/psi_serial_mod.o: auxil/psi_m_serial_mod.o auxil/psi_e_serial_mod.o \
auxil/psi_serial_mod.o: auxil/psi_i2_serial_mod.o auxil/psi_m_serial_mod.o auxil/psi_e_serial_mod.o \
auxil/psi_s_serial_mod.o auxil/psi_d_serial_mod.o\
auxil/psi_c_serial_mod.o auxil/psi_z_serial_mod.o \
auxil/psi_acx_mod.o auxil/psi_alcx_mod.o auxil/psi_lcx_mod.o
auxil/psi_m_serial_mod.o auxil/psi_e_serial_mod.o auxil/psi_s_serial_mod.o auxil/psi_d_serial_mod.o auxil/psi_c_serial_mod.o auxil/psi_z_serial_mod.o: psb_const_mod.o
auxil/psi_i2_serial_mod.o auxil/psi_m_serial_mod.o auxil/psi_e_serial_mod.o auxil/psi_s_serial_mod.o auxil/psi_d_serial_mod.o auxil/psi_c_serial_mod.o auxil/psi_z_serial_mod.o: psb_const_mod.o
auxil/psb_ip_reord_mod.o: auxil/psb_m_ip_reord_mod.o auxil/psb_e_ip_reord_mod.o \
auxil/psb_ip_reord_mod.o: auxil/psb_i2_ip_reord_mod.o auxil/psb_m_ip_reord_mod.o auxil/psb_e_ip_reord_mod.o \
auxil/psb_s_ip_reord_mod.o auxil/psb_d_ip_reord_mod.o \
auxil/psb_c_ip_reord_mod.o auxil/psb_z_ip_reord_mod.o
@@ -261,7 +277,8 @@ serial/psb_d_base_mat_mod.o: serial/psb_d_base_vect_mod.o
#serial/psb_ld_base_mat_mod.o: serial/psb_d_base_vect_mod.o
serial/psb_c_base_mat_mod.o: serial/psb_c_base_vect_mod.o
serial/psb_z_base_mat_mod.o: serial/psb_z_base_vect_mod.o
serial/psb_l_base_vect_mod.o: serial/psb_i_base_vect_mod.o
serial/psb_l_base_vect_mod.o: serial/psb_i_base_vect_mod.o
serial/psb_i2_base_vect_mod.o: serial/psb_i_base_vect_mod.o
serial/psb_c_base_vect_mod.o serial/psb_s_base_vect_mod.o serial/psb_d_base_vect_mod.o serial/psb_z_base_vect_mod.o: serial/psb_i_base_vect_mod.o serial/psb_l_base_vect_mod.o
serial/psb_i_base_vect_mod.o serial/psb_l_base_vect_mod.o serial/psb_c_base_vect_mod.o serial/psb_s_base_vect_mod.o serial/psb_d_base_vect_mod.o serial/psb_z_base_vect_mod.o: auxil/psi_serial_mod.o psb_realloc_mod.o
serial/psb_s_mat_mod.o: serial/psb_s_base_mat_mod.o serial/psb_s_csr_mat_mod.o serial/psb_s_csc_mat_mod.o serial/psb_s_vect_mod.o \
@@ -279,6 +296,7 @@ serial/psb_z_csc_mat_mod.o serial/psb_z_csr_mat_mod.o serial/psb_lz_csr_mat_mod.
serial/psb_mat_mod.o: serial/psb_vect_mod.o serial/psb_s_mat_mod.o serial/psb_d_mat_mod.o serial/psb_c_mat_mod.o serial/psb_z_mat_mod.o
serial/psb_serial_mod.o: serial/psb_s_serial_mod.o serial/psb_d_serial_mod.o serial/psb_c_serial_mod.o serial/psb_z_serial_mod.o auxil/psi_serial_mod.o
serial/psb_i2_vect_mod.o: serial/psb_i2_base_vect_mod.o serial/psb_i_base_vect_mod.o
serial/psb_i_vect_mod.o: serial/psb_i_base_vect_mod.o
serial/psb_l_vect_mod.o: serial/psb_l_base_vect_mod.o serial/psb_i_vect_mod.o
serial/psb_s_vect_mod.o: serial/psb_s_base_vect_mod.o serial/psb_i_vect_mod.o
@@ -305,10 +323,12 @@ desc/psb_desc_mod.o: psb_penv_mod.o psb_realloc_mod.o\
desc/psb_repl_map_mod.o desc/psb_gen_block_map_mod.o desc/psb_desc_const_mod.o\
desc/psb_indx_map_mod.o serial/psb_i_vect_mod.o
psi_i2_mod.o: desc/psb_desc_mod.o serial/psb_i2_vect_mod.o comm/psi_e_comm_a_mod.o \
comm/psi_m_comm_a_mod.o comm/psi_i_comm_v_mod.o comm/psi_i2_comm_a_mod.o comm/psi_i2_comm_v_mod.o
psi_i_mod.o: desc/psb_desc_mod.o serial/psb_i_vect_mod.o comm/psi_e_comm_a_mod.o \
comm/psi_m_comm_a_mod.o comm/psi_i_comm_v_mod.o comm/psi_i2_comm_a_mod.o
comm/psi_m_comm_a_mod.o comm/psi_i_comm_v_mod.o comm/psi_i2_comm_a_mod.o comm/psi_i2_comm_v_mod.o
psi_l_mod.o: desc/psb_desc_mod.o serial/psb_l_vect_mod.o comm/psi_e_comm_a_mod.o \
comm/psi_m_comm_a_mod.o comm/psi_l_comm_v_mod.o comm/psi_i2_comm_a_mod.o
comm/psi_m_comm_a_mod.o comm/psi_l_comm_v_mod.o comm/psi_i2_comm_a_mod.o comm/psi_i2_comm_v_mod.o
psi_s_mod.o: desc/psb_desc_mod.o serial/psb_s_vect_mod.o comm/psi_s_comm_a_mod.o \
comm/psi_s_comm_v_mod.o
psi_d_mod.o: desc/psb_desc_mod.o serial/psb_d_vect_mod.o comm/psi_d_comm_a_mod.o \
@@ -318,7 +338,7 @@ psi_c_mod.o: desc/psb_desc_mod.o serial/psb_c_vect_mod.o comm/psi_c_comm_a_mod.o
psi_z_mod.o: desc/psb_desc_mod.o serial/psb_z_vect_mod.o comm/psi_z_comm_a_mod.o \
comm/psi_z_comm_v_mod.o
psi_mod.o: psb_penv_mod.o desc/psb_desc_mod.o auxil/psi_serial_mod.o serial/psb_serial_mod.o\
psi_i_mod.o psi_l_mod.o psi_s_mod.o psi_d_mod.o psi_c_mod.o psi_z_mod.o
psi_i2_mod.o psi_i_mod.o psi_l_mod.o psi_s_mod.o psi_d_mod.o psi_c_mod.o psi_z_mod.o
desc/psb_indx_map_mod.o: desc/psb_desc_const_mod.o psb_error_mod.o psb_penv_mod.o psb_realloc_mod.o auxil/psb_sort_mod.o
desc/psb_hash_map_mod.o desc/psb_list_map_mod.o desc/psb_repl_map_mod.o desc/psb_gen_block_map_mod.o:\
@@ -338,24 +358,28 @@ comm/psb_c_linmap_mod.o: comm/psb_base_linmap_mod.o serial/psb_c_mat_mod.o seria
comm/psb_z_linmap_mod.o: comm/psb_base_linmap_mod.o serial/psb_z_mat_mod.o serial/psb_z_vect_mod.o
comm/psb_base_linmap_mod.o: desc/psb_desc_mod.o serial/psb_serial_mod.o comm/psb_comm_mod.o
comm/psb_comm_mod.o: desc/psb_desc_mod.o serial/psb_mat_mod.o
comm/psb_comm_mod.o: comm/psb_i_comm_mod.o comm/psb_l_comm_mod.o \
comm/psb_comm_mod.o: comm/psb_i2_comm_mod.o comm/psb_i_comm_mod.o comm/psb_l_comm_mod.o \
comm/psb_s_comm_mod.o comm/psb_d_comm_mod.o \
comm/psb_c_comm_mod.o comm/psb_z_comm_mod.o \
comm/psb_i2_comm_a_mod.o \
comm/psb_m_comm_a_mod.o comm/psb_e_comm_a_mod.o \
comm/psb_s_comm_a_mod.o comm/psb_d_comm_a_mod.o\
comm/psb_c_comm_a_mod.o comm/psb_z_comm_a_mod.o
comm/psb_m_comm_a_mod.o comm/psb_e_comm_a_mod.o \
comm/psb_i2_comm_a_mod.o comm/psb_m_comm_a_mod.o comm/psb_e_comm_a_mod.o \
comm/psb_s_comm_a_mod.o comm/psb_d_comm_a_mod.o\
comm/psb_c_comm_a_mod.o comm/psb_z_comm_a_mod.o: desc/psb_desc_mod.o
comm/psb_i_comm_mod.o: serial/psb_i_vect_mod.o desc/psb_desc_mod.o
comm/psb_i2_comm_mod.o: serial/psb_i2_vect_mod.o desc/psb_desc_mod.o
comm/psb_i_comm_mod.o: serial/psb_i_vect_mod.o desc/psb_desc_mod.o
comm/psb_l_comm_mod.o: serial/psb_l_vect_mod.o desc/psb_desc_mod.o
comm/psb_s_comm_mod.o: serial/psb_s_vect_mod.o desc/psb_desc_mod.o serial/psb_mat_mod.o
comm/psb_d_comm_mod.o: serial/psb_d_vect_mod.o desc/psb_desc_mod.o serial/psb_mat_mod.o
comm/psb_c_comm_mod.o: serial/psb_c_vect_mod.o desc/psb_desc_mod.o serial/psb_mat_mod.o
comm/psb_z_comm_mod.o: serial/psb_z_vect_mod.o desc/psb_desc_mod.o serial/psb_mat_mod.o
comm/psi_i2_comm_v_mod.o: serial/psb_i2_vect_mod.o comm/psi_i2_comm_a_mod.o \
comm/psi_m_comm_a_mod.o
comm/psi_i_comm_v_mod.o: serial/psb_i_vect_mod.o comm/psi_e_comm_a_mod.o \
comm/psi_m_comm_a_mod.o
comm/psi_l_comm_v_mod.o: serial/psb_l_vect_mod.o comm/psi_e_comm_a_mod.o \
@@ -374,14 +398,15 @@ comm/psi_c_comm_a_mod.o comm/psi_z_comm_a_mod.o: desc/psb_desc_mod.o
tools/psb_tools_mod.o: tools/psb_cd_tools_mod.o tools/psb_s_tools_mod.o tools/psb_d_tools_mod.o\
tools/psb_i_tools_mod.o tools/psb_l_tools_mod.o \
tools/psb_c_tools_mod.o tools/psb_z_tools_mod.o \
tools/psb_m_tools_a_mod.o tools/psb_e_tools_a_mod.o \
tools/psb_i2_tools_a_mod.o tools/psb_m_tools_a_mod.o tools/psb_e_tools_a_mod.o \
tools/psb_s_tools_a_mod.o tools/psb_d_tools_a_mod.o\
tools/psb_c_tools_a_mod.o tools/psb_z_tools_a_mod.o
tools/psb_cd_tools_mod.o tools/psb_i_tools_mod.o tools/psb_l_tools_mod.o \
tools/psb_s_tools_mod.o tools/psb_d_tools_mod.o \
tools/psb_c_tools_mod.o tools/psb_z_tools_mod.o tools/psb_m_tools_a_mod.o tools/psb_e_tools_a_mod.o \
tools/psb_c_tools_mod.o tools/psb_z_tools_mod.o \
tools/psb_i2_tools_a_mod.o tools/psb_m_tools_a_mod.o tools/psb_e_tools_a_mod.o \
tools/psb_s_tools_a_mod.o tools/psb_d_tools_a_mod.o\
tools/psb_c_tools_a_mod.o tools/psb_z_tools_a_mod.o: desc/psb_desc_mod.o psi_mod.o serial/psb_mat_mod.o
base/modules/auxil/psb_i2_hsort_x_mod.f90
+312
View File
@@ -0,0 +1,312 @@
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006-2018
! Salvatore Filippone
! Alfredo Buttari
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
! Sorting routines
! References:
! D. Knuth
! The Art of Computer Programming, vol. 3
! Addison-Wesley
!
! Aho, Hopcroft, Ullman
! Data Structures and Algorithms
! Addison-Wesley
!
module psb_i2_hsort_x_mod
use psb_const_mod
use psb_e_hsort_mod
use psb_m_hsort_mod
use psb_i2_hsort_mod
type psb_i2_heap
integer(psb_ipk_) :: dir
integer(psb_ipk_) :: last
integer(psb_i2pk_), allocatable :: keys(:)
contains
procedure, pass(heap) :: init => psb_i2_init_heap
procedure, pass(heap) :: howmany => psb_i2_howmany
procedure, pass(heap) :: insert => psb_i2_insert_heap
procedure, pass(heap) :: get_first => psb_i2_heap_get_first
procedure, pass(heap) :: dump => psb_i2_dump_heap
procedure, pass(heap) :: free => psb_i2_free_heap
end type psb_i2_heap
type psb_i2_idx_heap
integer(psb_ipk_) :: dir
integer(psb_ipk_) :: last
integer(psb_i2pk_), allocatable :: keys(:)
integer(psb_ipk_), allocatable :: idxs(:)
contains
procedure, pass(heap) :: init => psb_i2_idx_init_heap
procedure, pass(heap) :: howmany => psb_i2_idx_howmany
procedure, pass(heap) :: insert => psb_i2_idx_insert_heap
procedure, pass(heap) :: get_first => psb_i2_idx_heap_get_first
procedure, pass(heap) :: dump => psb_i2_idx_dump_heap
procedure, pass(heap) :: free => psb_i2_idx_free_heap
end type psb_i2_idx_heap
contains
subroutine psb_i2_init_heap(heap,info,dir)
use psb_realloc_mod, only : psb_ensure_size
implicit none
class(psb_i2_heap), intent(inout) :: heap
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: dir
info = psb_success_
heap%last=0
if (present(dir)) then
heap%dir = dir
else
heap%dir = psb_sort_up_
endif
select case(heap%dir)
case (psb_sort_up_,psb_sort_down_,psb_asort_up_,psb_asort_down_)
! ok, do nothing
case default
write(psb_err_unit,*) 'Invalid direction, defaulting to psb_sort_up_'
heap%dir = psb_sort_up_
end select
call psb_ensure_size(psb_heap_resize,heap%keys,info)
return
end subroutine psb_i2_init_heap
function psb_i2_howmany(heap) result(res)
implicit none
class(psb_i2_heap), intent(in) :: heap
integer(psb_ipk_) :: res
res = heap%last
end function psb_i2_howmany
subroutine psb_i2_insert_heap(key,heap,info)
use psb_realloc_mod, only : psb_ensure_size
implicit none
integer(psb_i2pk_), intent(in) :: key
class(psb_i2_heap), intent(inout) :: heap
integer(psb_ipk_), intent(out) :: info
info = psb_success_
if (heap%last < 0) then
write(psb_err_unit,*) 'Invalid last in heap ',heap%last
info = heap%last
return
endif
call psb_ensure_size(heap%last+1,heap%keys,info)
if (info /= psb_success_) then
write(psb_err_unit,*) 'Memory allocation failure in heap_insert'
info = -5
return
end if
call psi_insert_heap(key,&
& heap%last,heap%keys,heap%dir,info)
return
end subroutine psb_i2_insert_heap
subroutine psb_i2_heap_get_first(key,heap,info)
implicit none
class(psb_i2_heap), intent(inout) :: heap
integer(psb_ipk_), intent(out) :: info
integer(psb_i2pk_), intent(out) :: key
info = psb_success_
call psi_heap_get_first(key,&
& heap%last,heap%keys,heap%dir,info)
return
end subroutine psb_i2_heap_get_first
subroutine psb_i2_dump_heap(iout,heap,info)
implicit none
class(psb_i2_heap), intent(in) :: heap
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in) :: iout
info = psb_success_
if (iout < 0) then
write(psb_err_unit,*) 'Invalid file '
info =-1
return
end if
write(iout,*) 'Heap direction ',heap%dir
write(iout,*) 'Heap size ',heap%last
if ((heap%last > 0).and.((.not.allocated(heap%keys)).or.&
& (size(heap%keys)<heap%last))) then
write(iout,*) 'Inconsistent size/allocation status!!'
else
write(iout,*) heap%keys(1:heap%last)
end if
end subroutine psb_i2_dump_heap
subroutine psb_i2_free_heap(heap,info)
implicit none
class(psb_i2_heap), intent(inout) :: heap
integer(psb_ipk_), intent(out) :: info
info=psb_success_
if (allocated(heap%keys)) deallocate(heap%keys,stat=info)
end subroutine psb_i2_free_heap
subroutine psb_i2_idx_init_heap(heap,info,dir)
use psb_realloc_mod, only : psb_ensure_size
implicit none
class(psb_i2_idx_heap), intent(inout) :: heap
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: dir
info = psb_success_
heap%last=0
if (present(dir)) then
heap%dir = dir
else
heap%dir = psb_sort_up_
endif
select case(heap%dir)
case (psb_sort_up_,psb_sort_down_,psb_asort_up_,psb_asort_down_)
! ok, do nothing
case default
write(psb_err_unit,*) 'Invalid direction, defaulting to psb_sort_up_'
heap%dir = psb_sort_up_
end select
call psb_ensure_size(psb_heap_resize,heap%keys,info)
call psb_ensure_size(psb_heap_resize,heap%idxs,info)
return
end subroutine psb_i2_idx_init_heap
function psb_i2_idx_howmany(heap) result(res)
implicit none
class(psb_i2_idx_heap), intent(in) :: heap
integer(psb_ipk_) :: res
res = heap%last
end function psb_i2_idx_howmany
subroutine psb_i2_idx_insert_heap(key,index,heap,info)
use psb_realloc_mod, only : psb_ensure_size
implicit none
integer(psb_i2pk_), intent(in) :: key
integer(psb_ipk_), intent(in) :: index
class(psb_i2_idx_heap), intent(inout) :: heap
integer(psb_ipk_), intent(out) :: info
info = psb_success_
if (heap%last < 0) then
write(psb_err_unit,*) 'Invalid last in heap ',heap%last
info = heap%last
return
endif
call psb_ensure_size(heap%last+1,heap%keys,info)
if (info == psb_success_) &
& call psb_ensure_size(heap%last+1,heap%idxs,info)
if (info /= psb_success_) then
write(psb_err_unit,*) 'Memory allocation failure in heap_insert'
info = -5
return
end if
call psi_idx_insert_heap(key,index,&
& heap%last,heap%keys,heap%idxs,heap%dir,info)
return
end subroutine psb_i2_idx_insert_heap
subroutine psb_i2_idx_heap_get_first(key,index,heap,info)
implicit none
class(psb_i2_idx_heap), intent(inout) :: heap
integer(psb_ipk_), intent(out) :: index
integer(psb_ipk_), intent(out) :: info
integer(psb_i2pk_), intent(inout) :: key
info = psb_success_
call psi_idx_heap_get_first(key,index,&
& heap%last,heap%keys,heap%idxs,heap%dir,info)
return
end subroutine psb_i2_idx_heap_get_first
subroutine psb_i2_idx_dump_heap(iout,heap,info)
implicit none
class(psb_i2_idx_heap), intent(in) :: heap
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in) :: iout
info = psb_success_
if (iout < 0) then
write(psb_err_unit,*) 'Invalid file '
info =-1
return
end if
write(iout,*) 'Heap direction ',heap%dir
write(iout,*) 'Heap size ',heap%last
if ((heap%last > 0).and.((.not.allocated(heap%keys)).or.&
& (size(heap%keys)<heap%last))) then
write(iout,*) 'Inconsistent size/allocation status!!'
else if ((heap%last > 0).and.((.not.allocated(heap%idxs)).or.&
& (size(heap%idxs)<heap%last))) then
write(iout,*) 'Inconsistent size/allocation status!!'
else
write(iout,*) heap%keys(1:heap%last)
write(iout,*) heap%idxs(1:heap%last)
end if
end subroutine psb_i2_idx_dump_heap
subroutine psb_i2_idx_free_heap(heap,info)
implicit none
class(psb_i2_idx_heap), intent(inout) :: heap
integer(psb_ipk_), intent(out) :: info
info=psb_success_
if (allocated(heap%keys)) deallocate(heap%keys,stat=info)
if ((info == psb_success_).and.(allocated(heap%idxs))) &
& deallocate(heap%idxs,stat=info)
end subroutine psb_i2_idx_free_heap
end module psb_i2_hsort_x_mod
base/modules/auxil/psb_i_hsort_x_mod.f90
+1
View File
@@ -44,6 +44,7 @@ module psb_i_hsort_x_mod
use psb_const_mod
use psb_e_hsort_mod
use psb_m_hsort_mod
use psb_i2_hsort_mod
type psb_i_heap
integer(psb_ipk_) :: dir
base/modules/auxil/psb_ip_reord_mod.F90
+1
View File
@@ -37,6 +37,7 @@
!
!
module psb_ip_reord_mod
use psb_i2_ip_reord_mod
use psb_m_ip_reord_mod
use psb_e_ip_reord_mod
use psb_s_ip_reord_mod
base/modules/auxil/psb_l_hsort_x_mod.f90
+1
View File
@@ -44,6 +44,7 @@ module psb_l_hsort_x_mod
use psb_const_mod
use psb_e_hsort_mod
use psb_m_hsort_mod
use psb_i2_hsort_mod
type psb_l_heap
integer(psb_lpk_) :: dir
base/modules/auxil/psb_sort_mod.f90
+7 -1
View File
@@ -46,7 +46,12 @@ module psb_sort_mod
use psb_const_mod
use psb_ip_reord_mod
use psi_serial_mod
use psb_i2_hsort_mod
use psb_i2_isort_mod
use psb_i2_msort_mod
use psb_i2_qsort_mod
use psb_m_hsort_mod
use psb_m_isort_mod
use psb_m_msort_mod
@@ -77,6 +82,7 @@ module psb_sort_mod
use psb_z_msort_mod
use psb_z_qsort_mod
use psb_i2_hsort_x_mod
use psb_i_hsort_x_mod
use psb_l_hsort_x_mod
use psb_s_hsort_x_mod
base/modules/auxil/psi_c_serial_mod.f90
+18 -19
View File
@@ -35,7 +35,7 @@ module psi_c_serial_mod
interface psb_gelp
! 2-D version
subroutine psb_m_cgelp(trans,iperm,x,info)
import :: psb_ipk_, psb_mpk_, psb_spk_
import
implicit none
complex(psb_spk_), intent(inout) :: x(:,:)
integer(psb_mpk_), intent(in) :: iperm(:)
@@ -43,7 +43,7 @@ module psi_c_serial_mod
character, intent(in) :: trans
end subroutine psb_m_cgelp
subroutine psb_m_cgelpv(trans,iperm,x,info)
import :: psb_ipk_, psb_mpk_,psb_spk_
import
implicit none
complex(psb_spk_), intent(inout) :: x(:)
integer(psb_mpk_), intent(in) :: iperm(:)
@@ -51,7 +51,7 @@ module psi_c_serial_mod
character, intent(in) :: trans
end subroutine psb_m_cgelpv
subroutine psb_e_cgelp(trans,iperm,x,info)
import :: psb_ipk_, psb_epk_, psb_spk_
import
implicit none
complex(psb_spk_), intent(inout) :: x(:,:)
integer(psb_epk_), intent(in) :: iperm(:)
@@ -59,7 +59,7 @@ module psi_c_serial_mod
character, intent(in) :: trans
end subroutine psb_e_cgelp
subroutine psb_e_cgelpv(trans,iperm,x,info)
import :: psb_ipk_, psb_epk_, psb_spk_
import
implicit none
complex(psb_spk_), intent(inout) :: x(:)
integer(psb_epk_), intent(in) :: iperm(:)
@@ -70,7 +70,7 @@ module psi_c_serial_mod
interface psb_geaxpby
subroutine psi_caxpby(m,n,alpha, x, beta, y, info)
import :: psb_ipk_, psb_spk_
import
implicit none
integer(psb_ipk_), intent(in) :: m, n
complex(psb_spk_), intent (in) :: x(:,:)
@@ -79,7 +79,7 @@ module psi_c_serial_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psi_caxpby
subroutine psi_caxpbyv(m,alpha, x, beta, y, info)
import :: psb_ipk_, psb_spk_
import
implicit none
integer(psb_ipk_), intent(in) :: m
complex(psb_spk_), intent (in) :: x(:)
@@ -88,7 +88,7 @@ module psi_c_serial_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psi_caxpbyv
subroutine psi_caxpbyv2(m,alpha, x, beta, y, z, info)
import :: psb_ipk_, psb_spk_
import
implicit none
integer(psb_ipk_), intent(in) :: m
complex(psb_spk_), intent (in) :: x(:)
@@ -101,7 +101,7 @@ module psi_c_serial_mod
interface psi_upd_xyz
subroutine psi_c_upd_xyz(m,alpha, beta, gamma,delta,x, y, z, info)
import :: psb_ipk_, psb_spk_
import
implicit none
integer(psb_ipk_), intent(in) :: m
complex(psb_spk_), intent (in) :: x(:)
@@ -114,7 +114,7 @@ module psi_c_serial_mod
interface psi_xyzw
subroutine psi_cxyzw(m,a,b,c,d,e,f,x, y, z,w, info)
import :: psb_ipk_, psb_spk_
import
implicit none
integer(psb_ipk_), intent(in) :: m
complex(psb_spk_), intent (in) :: x(:)
@@ -128,21 +128,21 @@ module psi_c_serial_mod
interface psi_gth
subroutine psi_cgthmv(n,k,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_mpk_, psb_spk_
import
implicit none
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
complex(psb_spk_) :: x(:,:), y(:),alpha,beta
end subroutine psi_cgthmv
subroutine psi_cgthv(n,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_mpk_, psb_spk_
import
implicit none
integer(psb_mpk_) :: n
integer(psb_ipk_) :: idx(:)
complex(psb_spk_) :: x(:), y(:),alpha,beta
end subroutine psi_cgthv
subroutine psi_cgthzmv(n,k,idx,x,y)
import :: psb_ipk_, psb_mpk_, psb_spk_
import
implicit none
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
@@ -150,7 +150,7 @@ module psi_c_serial_mod
end subroutine psi_cgthzmv
subroutine psi_cgthzmm(n,k,idx,x,y)
import :: psb_ipk_, psb_mpk_, psb_spk_
import
implicit none
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
@@ -158,8 +158,7 @@ module psi_c_serial_mod
end subroutine psi_cgthzmm
subroutine psi_cgthzv(n,idx,x,y)
import :: psb_ipk_, psb_mpk_, psb_spk_
implicit none
import
integer(psb_mpk_) :: n
integer(psb_ipk_) :: idx(:)
complex(psb_spk_) :: x(:), y(:)
@@ -168,21 +167,21 @@ module psi_c_serial_mod
interface psi_sct
subroutine psi_csctmm(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_mpk_, psb_spk_
import
implicit none
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
complex(psb_spk_) :: beta, x(:,:), y(:,:)
end subroutine psi_csctmm
subroutine psi_csctmv(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_mpk_, psb_spk_
import
implicit none
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
complex(psb_spk_) :: beta, x(:), y(:,:)
end subroutine psi_csctmv
subroutine psi_csctv(n,idx,x,beta,y)
import :: psb_ipk_, psb_mpk_, psb_spk_
import
implicit none
integer(psb_mpk_) :: n
@@ -193,7 +192,7 @@ module psi_c_serial_mod
interface psi_exscan
subroutine psi_c_exscanv(n,x,info,shift)
import :: psb_ipk_, psb_mpk_, psb_spk_
import
implicit none
integer(psb_ipk_), intent(in) :: n
complex(psb_spk_), intent (inout) :: x(:)
base/modules/auxil/psi_d_serial_mod.f90
+18 -19
View File
@@ -35,7 +35,7 @@ module psi_d_serial_mod
interface psb_gelp
! 2-D version
subroutine psb_m_dgelp(trans,iperm,x,info)
import :: psb_ipk_, psb_mpk_, psb_dpk_
import
implicit none
real(psb_dpk_), intent(inout) :: x(:,:)
integer(psb_mpk_), intent(in) :: iperm(:)
@@ -43,7 +43,7 @@ module psi_d_serial_mod
character, intent(in) :: trans
end subroutine psb_m_dgelp
subroutine psb_m_dgelpv(trans,iperm,x,info)
import :: psb_ipk_, psb_mpk_,psb_dpk_
import
implicit none
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_mpk_), intent(in) :: iperm(:)
@@ -51,7 +51,7 @@ module psi_d_serial_mod
character, intent(in) :: trans
end subroutine psb_m_dgelpv
subroutine psb_e_dgelp(trans,iperm,x,info)
import :: psb_ipk_, psb_epk_, psb_dpk_
import
implicit none
real(psb_dpk_), intent(inout) :: x(:,:)
integer(psb_epk_), intent(in) :: iperm(:)
@@ -59,7 +59,7 @@ module psi_d_serial_mod
character, intent(in) :: trans
end subroutine psb_e_dgelp
subroutine psb_e_dgelpv(trans,iperm,x,info)
import :: psb_ipk_, psb_epk_, psb_dpk_
import
implicit none
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_epk_), intent(in) :: iperm(:)
@@ -70,7 +70,7 @@ module psi_d_serial_mod
interface psb_geaxpby
subroutine psi_daxpby(m,n,alpha, x, beta, y, info)
import :: psb_ipk_, psb_dpk_
import
implicit none
integer(psb_ipk_), intent(in) :: m, n
real(psb_dpk_), intent (in) :: x(:,:)
@@ -79,7 +79,7 @@ module psi_d_serial_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psi_daxpby
subroutine psi_daxpbyv(m,alpha, x, beta, y, info)
import :: psb_ipk_, psb_dpk_
import
implicit none
integer(psb_ipk_), intent(in) :: m
real(psb_dpk_), intent (in) :: x(:)
@@ -88,7 +88,7 @@ module psi_d_serial_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psi_daxpbyv
subroutine psi_daxpbyv2(m,alpha, x, beta, y, z, info)
import :: psb_ipk_, psb_dpk_
import
implicit none
integer(psb_ipk_), intent(in) :: m
real(psb_dpk_), intent (in) :: x(:)
@@ -101,7 +101,7 @@ module psi_d_serial_mod
interface psi_upd_xyz
subroutine psi_d_upd_xyz(m,alpha, beta, gamma,delta,x, y, z, info)
import :: psb_ipk_, psb_dpk_
import
implicit none
integer(psb_ipk_), intent(in) :: m
real(psb_dpk_), intent (in) :: x(:)
@@ -114,7 +114,7 @@ module psi_d_serial_mod
interface psi_xyzw
subroutine psi_dxyzw(m,a,b,c,d,e,f,x, y, z,w, info)
import :: psb_ipk_, psb_dpk_
import
implicit none
integer(psb_ipk_), intent(in) :: m
real(psb_dpk_), intent (in) :: x(:)
@@ -128,21 +128,21 @@ module psi_d_serial_mod
interface psi_gth
subroutine psi_dgthmv(n,k,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_mpk_, psb_dpk_
import
implicit none
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
real(psb_dpk_) :: x(:,:), y(:),alpha,beta
end subroutine psi_dgthmv
subroutine psi_dgthv(n,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_mpk_, psb_dpk_
import
implicit none
integer(psb_mpk_) :: n
integer(psb_ipk_) :: idx(:)
real(psb_dpk_) :: x(:), y(:),alpha,beta
end subroutine psi_dgthv
subroutine psi_dgthzmv(n,k,idx,x,y)
import :: psb_ipk_, psb_mpk_, psb_dpk_
import
implicit none
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
@@ -150,7 +150,7 @@ module psi_d_serial_mod
end subroutine psi_dgthzmv
subroutine psi_dgthzmm(n,k,idx,x,y)
import :: psb_ipk_, psb_mpk_, psb_dpk_
import
implicit none
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
@@ -158,8 +158,7 @@ module psi_d_serial_mod
end subroutine psi_dgthzmm
subroutine psi_dgthzv(n,idx,x,y)
import :: psb_ipk_, psb_mpk_, psb_dpk_
implicit none
import
integer(psb_mpk_) :: n
integer(psb_ipk_) :: idx(:)
real(psb_dpk_) :: x(:), y(:)
@@ -168,21 +167,21 @@ module psi_d_serial_mod
interface psi_sct
subroutine psi_dsctmm(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_mpk_, psb_dpk_
import
implicit none
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
real(psb_dpk_) :: beta, x(:,:), y(:,:)
end subroutine psi_dsctmm
subroutine psi_dsctmv(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_mpk_, psb_dpk_
import
implicit none
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
real(psb_dpk_) :: beta, x(:), y(:,:)
end subroutine psi_dsctmv
subroutine psi_dsctv(n,idx,x,beta,y)
import :: psb_ipk_, psb_mpk_, psb_dpk_
import
implicit none
integer(psb_mpk_) :: n
@@ -193,7 +192,7 @@ module psi_d_serial_mod
interface psi_exscan
subroutine psi_d_exscanv(n,x,info,shift)
import :: psb_ipk_, psb_mpk_, psb_dpk_
import
implicit none
integer(psb_ipk_), intent(in) :: n
real(psb_dpk_), intent (inout) :: x(:)
base/modules/auxil/psi_e_serial_mod.f90
+19 -20
View File
@@ -30,12 +30,12 @@
!
!
module psi_e_serial_mod
use psb_const_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_
use psb_const_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_, psb_i2pk_
interface psb_gelp
! 2-D version
subroutine psb_m_egelp(trans,iperm,x,info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_epk_), intent(inout) :: x(:,:)
integer(psb_mpk_), intent(in) :: iperm(:)
@@ -43,7 +43,7 @@ module psi_e_serial_mod
character, intent(in) :: trans
end subroutine psb_m_egelp
subroutine psb_m_egelpv(trans,iperm,x,info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_epk_), intent(inout) :: x(:)
integer(psb_mpk_), intent(in) :: iperm(:)
@@ -51,7 +51,7 @@ module psi_e_serial_mod
character, intent(in) :: trans
end subroutine psb_m_egelpv
subroutine psb_e_egelp(trans,iperm,x,info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_epk_), intent(inout) :: x(:,:)
integer(psb_epk_), intent(in) :: iperm(:)
@@ -59,7 +59,7 @@ module psi_e_serial_mod
character, intent(in) :: trans
end subroutine psb_e_egelp
subroutine psb_e_egelpv(trans,iperm,x,info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_epk_), intent(inout) :: x(:)
integer(psb_epk_), intent(in) :: iperm(:)
@@ -70,7 +70,7 @@ module psi_e_serial_mod
interface psb_geaxpby
subroutine psi_eaxpby(m,n,alpha, x, beta, y, info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_ipk_), intent(in) :: m, n
integer(psb_epk_), intent (in) :: x(:,:)
@@ -79,7 +79,7 @@ module psi_e_serial_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psi_eaxpby
subroutine psi_eaxpbyv(m,alpha, x, beta, y, info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_ipk_), intent(in) :: m
integer(psb_epk_), intent (in) :: x(:)
@@ -88,7 +88,7 @@ module psi_e_serial_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psi_eaxpbyv
subroutine psi_eaxpbyv2(m,alpha, x, beta, y, z, info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_ipk_), intent(in) :: m
integer(psb_epk_), intent (in) :: x(:)
@@ -101,7 +101,7 @@ module psi_e_serial_mod
interface psi_upd_xyz
subroutine psi_e_upd_xyz(m,alpha, beta, gamma,delta,x, y, z, info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_ipk_), intent(in) :: m
integer(psb_epk_), intent (in) :: x(:)
@@ -114,7 +114,7 @@ module psi_e_serial_mod
interface psi_xyzw
subroutine psi_exyzw(m,a,b,c,d,e,f,x, y, z,w, info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_ipk_), intent(in) :: m
integer(psb_epk_), intent (in) :: x(:)
@@ -128,21 +128,21 @@ module psi_e_serial_mod
interface psi_gth
subroutine psi_egthmv(n,k,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
integer(psb_epk_) :: x(:,:), y(:),alpha,beta
end subroutine psi_egthmv
subroutine psi_egthv(n,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_mpk_) :: n
integer(psb_ipk_) :: idx(:)
integer(psb_epk_) :: x(:), y(:),alpha,beta
end subroutine psi_egthv
subroutine psi_egthzmv(n,k,idx,x,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
@@ -150,7 +150,7 @@ module psi_e_serial_mod
end subroutine psi_egthzmv
subroutine psi_egthzmm(n,k,idx,x,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
@@ -158,8 +158,7 @@ module psi_e_serial_mod
end subroutine psi_egthzmm
subroutine psi_egthzv(n,idx,x,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
import
integer(psb_mpk_) :: n
integer(psb_ipk_) :: idx(:)
integer(psb_epk_) :: x(:), y(:)
@@ -168,21 +167,21 @@ module psi_e_serial_mod
interface psi_sct
subroutine psi_esctmm(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
integer(psb_epk_) :: beta, x(:,:), y(:,:)
end subroutine psi_esctmm
subroutine psi_esctmv(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
integer(psb_epk_) :: beta, x(:), y(:,:)
end subroutine psi_esctmv
subroutine psi_esctv(n,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_mpk_) :: n
@@ -193,7 +192,7 @@ module psi_e_serial_mod
interface psi_exscan
subroutine psi_e_exscanv(n,x,info,shift)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_ipk_), intent(in) :: n
integer(psb_epk_), intent (inout) :: x(:)
base/modules/auxil/psi_i2_serial_mod.f90
+19 -20
View File
@@ -30,12 +30,12 @@
!
!
module psi_i2_serial_mod
use psb_const_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_
use psb_const_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_, psb_i2pk_
interface psb_gelp
! 2-D version
subroutine psb_m_i2gelp(trans,iperm,x,info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_i2pk_), intent(inout) :: x(:,:)
integer(psb_mpk_), intent(in) :: iperm(:)
@@ -43,7 +43,7 @@ module psi_i2_serial_mod
character, intent(in) :: trans
end subroutine psb_m_i2gelp
subroutine psb_m_i2gelpv(trans,iperm,x,info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_i2pk_), intent(inout) :: x(:)
integer(psb_mpk_), intent(in) :: iperm(:)
@@ -51,7 +51,7 @@ module psi_i2_serial_mod
character, intent(in) :: trans
end subroutine psb_m_i2gelpv
subroutine psb_e_i2gelp(trans,iperm,x,info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_i2pk_), intent(inout) :: x(:,:)
integer(psb_epk_), intent(in) :: iperm(:)
@@ -59,7 +59,7 @@ module psi_i2_serial_mod
character, intent(in) :: trans
end subroutine psb_e_i2gelp
subroutine psb_e_i2gelpv(trans,iperm,x,info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_i2pk_), intent(inout) :: x(:)
integer(psb_epk_), intent(in) :: iperm(:)
@@ -70,7 +70,7 @@ module psi_i2_serial_mod
interface psb_geaxpby
subroutine psi_i2axpby(m,n,alpha, x, beta, y, info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_ipk_), intent(in) :: m, n
integer(psb_i2pk_), intent (in) :: x(:,:)
@@ -79,7 +79,7 @@ module psi_i2_serial_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psi_i2axpby
subroutine psi_i2axpbyv(m,alpha, x, beta, y, info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_ipk_), intent(in) :: m
integer(psb_i2pk_), intent (in) :: x(:)
@@ -88,7 +88,7 @@ module psi_i2_serial_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psi_i2axpbyv
subroutine psi_i2axpbyv2(m,alpha, x, beta, y, z, info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_ipk_), intent(in) :: m
integer(psb_i2pk_), intent (in) :: x(:)
@@ -101,7 +101,7 @@ module psi_i2_serial_mod
interface psi_upd_xyz
subroutine psi_i2_upd_xyz(m,alpha, beta, gamma,delta,x, y, z, info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_ipk_), intent(in) :: m
integer(psb_i2pk_), intent (in) :: x(:)
@@ -114,7 +114,7 @@ module psi_i2_serial_mod
interface psi_xyzw
subroutine psi_i2xyzw(m,a,b,c,d,e,f,x, y, z,w, info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_ipk_), intent(in) :: m
integer(psb_i2pk_), intent (in) :: x(:)
@@ -128,21 +128,21 @@ module psi_i2_serial_mod
interface psi_gth
subroutine psi_i2gthmv(n,k,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
integer(psb_i2pk_) :: x(:,:), y(:),alpha,beta
end subroutine psi_i2gthmv
subroutine psi_i2gthv(n,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_mpk_) :: n
integer(psb_ipk_) :: idx(:)
integer(psb_i2pk_) :: x(:), y(:),alpha,beta
end subroutine psi_i2gthv
subroutine psi_i2gthzmv(n,k,idx,x,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
@@ -150,7 +150,7 @@ module psi_i2_serial_mod
end subroutine psi_i2gthzmv
subroutine psi_i2gthzmm(n,k,idx,x,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
@@ -158,8 +158,7 @@ module psi_i2_serial_mod
end subroutine psi_i2gthzmm
subroutine psi_i2gthzv(n,idx,x,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
import
integer(psb_mpk_) :: n
integer(psb_ipk_) :: idx(:)
integer(psb_i2pk_) :: x(:), y(:)
@@ -168,21 +167,21 @@ module psi_i2_serial_mod
interface psi_sct
subroutine psi_i2sctmm(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
integer(psb_i2pk_) :: beta, x(:,:), y(:,:)
end subroutine psi_i2sctmm
subroutine psi_i2sctmv(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
integer(psb_i2pk_) :: beta, x(:), y(:,:)
end subroutine psi_i2sctmv
subroutine psi_i2sctv(n,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_mpk_) :: n
@@ -193,7 +192,7 @@ module psi_i2_serial_mod
interface psi_exscan
subroutine psi_i2_exscanv(n,x,info,shift)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_ipk_), intent(in) :: n
integer(psb_i2pk_), intent (inout) :: x(:)
base/modules/auxil/psi_m_serial_mod.f90
+19 -20
View File
@@ -30,12 +30,12 @@
!
!
module psi_m_serial_mod
use psb_const_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_
use psb_const_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_, psb_i2pk_
interface psb_gelp
! 2-D version
subroutine psb_m_mgelp(trans,iperm,x,info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_mpk_), intent(inout) :: x(:,:)
integer(psb_mpk_), intent(in) :: iperm(:)
@@ -43,7 +43,7 @@ module psi_m_serial_mod
character, intent(in) :: trans
end subroutine psb_m_mgelp
subroutine psb_m_mgelpv(trans,iperm,x,info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_mpk_), intent(inout) :: x(:)
integer(psb_mpk_), intent(in) :: iperm(:)
@@ -51,7 +51,7 @@ module psi_m_serial_mod
character, intent(in) :: trans
end subroutine psb_m_mgelpv
subroutine psb_e_mgelp(trans,iperm,x,info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_mpk_), intent(inout) :: x(:,:)
integer(psb_epk_), intent(in) :: iperm(:)
@@ -59,7 +59,7 @@ module psi_m_serial_mod
character, intent(in) :: trans
end subroutine psb_e_mgelp
subroutine psb_e_mgelpv(trans,iperm,x,info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_mpk_), intent(inout) :: x(:)
integer(psb_epk_), intent(in) :: iperm(:)
@@ -70,7 +70,7 @@ module psi_m_serial_mod
interface psb_geaxpby
subroutine psi_maxpby(m,n,alpha, x, beta, y, info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_ipk_), intent(in) :: m, n
integer(psb_mpk_), intent (in) :: x(:,:)
@@ -79,7 +79,7 @@ module psi_m_serial_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psi_maxpby
subroutine psi_maxpbyv(m,alpha, x, beta, y, info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_ipk_), intent(in) :: m
integer(psb_mpk_), intent (in) :: x(:)
@@ -88,7 +88,7 @@ module psi_m_serial_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psi_maxpbyv
subroutine psi_maxpbyv2(m,alpha, x, beta, y, z, info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_ipk_), intent(in) :: m
integer(psb_mpk_), intent (in) :: x(:)
@@ -101,7 +101,7 @@ module psi_m_serial_mod
interface psi_upd_xyz
subroutine psi_m_upd_xyz(m,alpha, beta, gamma,delta,x, y, z, info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_ipk_), intent(in) :: m
integer(psb_mpk_), intent (in) :: x(:)
@@ -114,7 +114,7 @@ module psi_m_serial_mod
interface psi_xyzw
subroutine psi_mxyzw(m,a,b,c,d,e,f,x, y, z,w, info)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_ipk_), intent(in) :: m
integer(psb_mpk_), intent (in) :: x(:)
@@ -128,21 +128,21 @@ module psi_m_serial_mod
interface psi_gth
subroutine psi_mgthmv(n,k,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
integer(psb_mpk_) :: x(:,:), y(:),alpha,beta
end subroutine psi_mgthmv
subroutine psi_mgthv(n,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_mpk_) :: n
integer(psb_ipk_) :: idx(:)
integer(psb_mpk_) :: x(:), y(:),alpha,beta
end subroutine psi_mgthv
subroutine psi_mgthzmv(n,k,idx,x,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
@@ -150,7 +150,7 @@ module psi_m_serial_mod
end subroutine psi_mgthzmv
subroutine psi_mgthzmm(n,k,idx,x,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
@@ -158,8 +158,7 @@ module psi_m_serial_mod
end subroutine psi_mgthzmm
subroutine psi_mgthzv(n,idx,x,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
implicit none
import
integer(psb_mpk_) :: n
integer(psb_ipk_) :: idx(:)
integer(psb_mpk_) :: x(:), y(:)
@@ -168,21 +167,21 @@ module psi_m_serial_mod
interface psi_sct
subroutine psi_msctmm(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
integer(psb_mpk_) :: beta, x(:,:), y(:,:)
end subroutine psi_msctmm
subroutine psi_msctmv(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
integer(psb_mpk_) :: beta, x(:), y(:,:)
end subroutine psi_msctmv
subroutine psi_msctv(n,idx,x,beta,y)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_mpk_) :: n
@@ -193,7 +192,7 @@ module psi_m_serial_mod
interface psi_exscan
subroutine psi_m_exscanv(n,x,info,shift)
import :: psb_ipk_, psb_lpk_,psb_mpk_, psb_epk_
import
implicit none
integer(psb_ipk_), intent(in) :: n
integer(psb_mpk_), intent (inout) :: x(:)
base/modules/auxil/psi_s_serial_mod.f90
+18 -19
View File
@@ -35,7 +35,7 @@ module psi_s_serial_mod
interface psb_gelp
! 2-D version
subroutine psb_m_sgelp(trans,iperm,x,info)
import :: psb_ipk_, psb_mpk_, psb_spk_
import
implicit none
real(psb_spk_), intent(inout) :: x(:,:)
integer(psb_mpk_), intent(in) :: iperm(:)
@@ -43,7 +43,7 @@ module psi_s_serial_mod
character, intent(in) :: trans
end subroutine psb_m_sgelp
subroutine psb_m_sgelpv(trans,iperm,x,info)
import :: psb_ipk_, psb_mpk_,psb_spk_
import
implicit none
real(psb_spk_), intent(inout) :: x(:)
integer(psb_mpk_), intent(in) :: iperm(:)
@@ -51,7 +51,7 @@ module psi_s_serial_mod
character, intent(in) :: trans
end subroutine psb_m_sgelpv
subroutine psb_e_sgelp(trans,iperm,x,info)
import :: psb_ipk_, psb_epk_, psb_spk_
import
implicit none
real(psb_spk_), intent(inout) :: x(:,:)
integer(psb_epk_), intent(in) :: iperm(:)
@@ -59,7 +59,7 @@ module psi_s_serial_mod
character, intent(in) :: trans
end subroutine psb_e_sgelp
subroutine psb_e_sgelpv(trans,iperm,x,info)
import :: psb_ipk_, psb_epk_, psb_spk_
import
implicit none
real(psb_spk_), intent(inout) :: x(:)
integer(psb_epk_), intent(in) :: iperm(:)
@@ -70,7 +70,7 @@ module psi_s_serial_mod
interface psb_geaxpby
subroutine psi_saxpby(m,n,alpha, x, beta, y, info)
import :: psb_ipk_, psb_spk_
import
implicit none
integer(psb_ipk_), intent(in) :: m, n
real(psb_spk_), intent (in) :: x(:,:)
@@ -79,7 +79,7 @@ module psi_s_serial_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psi_saxpby
subroutine psi_saxpbyv(m,alpha, x, beta, y, info)
import :: psb_ipk_, psb_spk_
import
implicit none
integer(psb_ipk_), intent(in) :: m
real(psb_spk_), intent (in) :: x(:)
@@ -88,7 +88,7 @@ module psi_s_serial_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psi_saxpbyv
subroutine psi_saxpbyv2(m,alpha, x, beta, y, z, info)
import :: psb_ipk_, psb_spk_
import
implicit none
integer(psb_ipk_), intent(in) :: m
real(psb_spk_), intent (in) :: x(:)
@@ -101,7 +101,7 @@ module psi_s_serial_mod
interface psi_upd_xyz
subroutine psi_s_upd_xyz(m,alpha, beta, gamma,delta,x, y, z, info)
import :: psb_ipk_, psb_spk_
import
implicit none
integer(psb_ipk_), intent(in) :: m
real(psb_spk_), intent (in) :: x(:)
@@ -114,7 +114,7 @@ module psi_s_serial_mod
interface psi_xyzw
subroutine psi_sxyzw(m,a,b,c,d,e,f,x, y, z,w, info)
import :: psb_ipk_, psb_spk_
import
implicit none
integer(psb_ipk_), intent(in) :: m
real(psb_spk_), intent (in) :: x(:)
@@ -128,21 +128,21 @@ module psi_s_serial_mod
interface psi_gth
subroutine psi_sgthmv(n,k,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_mpk_, psb_spk_
import
implicit none
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
real(psb_spk_) :: x(:,:), y(:),alpha,beta
end subroutine psi_sgthmv
subroutine psi_sgthv(n,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_mpk_, psb_spk_
import
implicit none
integer(psb_mpk_) :: n
integer(psb_ipk_) :: idx(:)
real(psb_spk_) :: x(:), y(:),alpha,beta
end subroutine psi_sgthv
subroutine psi_sgthzmv(n,k,idx,x,y)
import :: psb_ipk_, psb_mpk_, psb_spk_
import
implicit none
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
@@ -150,7 +150,7 @@ module psi_s_serial_mod
end subroutine psi_sgthzmv
subroutine psi_sgthzmm(n,k,idx,x,y)
import :: psb_ipk_, psb_mpk_, psb_spk_
import
implicit none
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
@@ -158,8 +158,7 @@ module psi_s_serial_mod
end subroutine psi_sgthzmm
subroutine psi_sgthzv(n,idx,x,y)
import :: psb_ipk_, psb_mpk_, psb_spk_
implicit none
import
integer(psb_mpk_) :: n
integer(psb_ipk_) :: idx(:)
real(psb_spk_) :: x(:), y(:)
@@ -168,21 +167,21 @@ module psi_s_serial_mod
interface psi_sct
subroutine psi_ssctmm(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_mpk_, psb_spk_
import
implicit none
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
real(psb_spk_) :: beta, x(:,:), y(:,:)
end subroutine psi_ssctmm
subroutine psi_ssctmv(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_mpk_, psb_spk_
import
implicit none
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
real(psb_spk_) :: beta, x(:), y(:,:)
end subroutine psi_ssctmv
subroutine psi_ssctv(n,idx,x,beta,y)
import :: psb_ipk_, psb_mpk_, psb_spk_
import
implicit none
integer(psb_mpk_) :: n
@@ -193,7 +192,7 @@ module psi_s_serial_mod
interface psi_exscan
subroutine psi_s_exscanv(n,x,info,shift)
import :: psb_ipk_, psb_mpk_, psb_spk_
import
implicit none
integer(psb_ipk_), intent(in) :: n
real(psb_spk_), intent (inout) :: x(:)
base/modules/auxil/psi_serial_mod.f90
+1
View File
@@ -30,6 +30,7 @@
!
!
module psi_serial_mod
use psi_i2_serial_mod
use psi_m_serial_mod
use psi_e_serial_mod
use psi_s_serial_mod
base/modules/auxil/psi_z_serial_mod.f90
+18 -19
View File
@@ -35,7 +35,7 @@ module psi_z_serial_mod
interface psb_gelp
! 2-D version
subroutine psb_m_zgelp(trans,iperm,x,info)
import :: psb_ipk_, psb_mpk_, psb_dpk_
import
implicit none
complex(psb_dpk_), intent(inout) :: x(:,:)
integer(psb_mpk_), intent(in) :: iperm(:)
@@ -43,7 +43,7 @@ module psi_z_serial_mod
character, intent(in) :: trans
end subroutine psb_m_zgelp
subroutine psb_m_zgelpv(trans,iperm,x,info)
import :: psb_ipk_, psb_mpk_,psb_dpk_
import
implicit none
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_mpk_), intent(in) :: iperm(:)
@@ -51,7 +51,7 @@ module psi_z_serial_mod
character, intent(in) :: trans
end subroutine psb_m_zgelpv
subroutine psb_e_zgelp(trans,iperm,x,info)
import :: psb_ipk_, psb_epk_, psb_dpk_
import
implicit none
complex(psb_dpk_), intent(inout) :: x(:,:)
integer(psb_epk_), intent(in) :: iperm(:)
@@ -59,7 +59,7 @@ module psi_z_serial_mod
character, intent(in) :: trans
end subroutine psb_e_zgelp
subroutine psb_e_zgelpv(trans,iperm,x,info)
import :: psb_ipk_, psb_epk_, psb_dpk_
import
implicit none
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_epk_), intent(in) :: iperm(:)
@@ -70,7 +70,7 @@ module psi_z_serial_mod
interface psb_geaxpby
subroutine psi_zaxpby(m,n,alpha, x, beta, y, info)
import :: psb_ipk_, psb_dpk_
import
implicit none
integer(psb_ipk_), intent(in) :: m, n
complex(psb_dpk_), intent (in) :: x(:,:)
@@ -79,7 +79,7 @@ module psi_z_serial_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psi_zaxpby
subroutine psi_zaxpbyv(m,alpha, x, beta, y, info)
import :: psb_ipk_, psb_dpk_
import
implicit none
integer(psb_ipk_), intent(in) :: m
complex(psb_dpk_), intent (in) :: x(:)
@@ -88,7 +88,7 @@ module psi_z_serial_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psi_zaxpbyv
subroutine psi_zaxpbyv2(m,alpha, x, beta, y, z, info)
import :: psb_ipk_, psb_dpk_
import
implicit none
integer(psb_ipk_), intent(in) :: m
complex(psb_dpk_), intent (in) :: x(:)
@@ -101,7 +101,7 @@ module psi_z_serial_mod
interface psi_upd_xyz
subroutine psi_z_upd_xyz(m,alpha, beta, gamma,delta,x, y, z, info)
import :: psb_ipk_, psb_dpk_
import
implicit none
integer(psb_ipk_), intent(in) :: m
complex(psb_dpk_), intent (in) :: x(:)
@@ -114,7 +114,7 @@ module psi_z_serial_mod
interface psi_xyzw
subroutine psi_zxyzw(m,a,b,c,d,e,f,x, y, z,w, info)
import :: psb_ipk_, psb_dpk_
import
implicit none
integer(psb_ipk_), intent(in) :: m
complex(psb_dpk_), intent (in) :: x(:)
@@ -128,21 +128,21 @@ module psi_z_serial_mod
interface psi_gth
subroutine psi_zgthmv(n,k,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_mpk_, psb_dpk_
import
implicit none
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
complex(psb_dpk_) :: x(:,:), y(:),alpha,beta
end subroutine psi_zgthmv
subroutine psi_zgthv(n,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_mpk_, psb_dpk_
import
implicit none
integer(psb_mpk_) :: n
integer(psb_ipk_) :: idx(:)
complex(psb_dpk_) :: x(:), y(:),alpha,beta
end subroutine psi_zgthv
subroutine psi_zgthzmv(n,k,idx,x,y)
import :: psb_ipk_, psb_mpk_, psb_dpk_
import
implicit none
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
@@ -150,7 +150,7 @@ module psi_z_serial_mod
end subroutine psi_zgthzmv
subroutine psi_zgthzmm(n,k,idx,x,y)
import :: psb_ipk_, psb_mpk_, psb_dpk_
import
implicit none
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
@@ -158,8 +158,7 @@ module psi_z_serial_mod
end subroutine psi_zgthzmm
subroutine psi_zgthzv(n,idx,x,y)
import :: psb_ipk_, psb_mpk_, psb_dpk_
implicit none
import
integer(psb_mpk_) :: n
integer(psb_ipk_) :: idx(:)
complex(psb_dpk_) :: x(:), y(:)
@@ -168,21 +167,21 @@ module psi_z_serial_mod
interface psi_sct
subroutine psi_zsctmm(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_mpk_, psb_dpk_
import
implicit none
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
complex(psb_dpk_) :: beta, x(:,:), y(:,:)
end subroutine psi_zsctmm
subroutine psi_zsctmv(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_mpk_, psb_dpk_
import
implicit none
integer(psb_mpk_) :: n, k
integer(psb_ipk_) :: idx(:)
complex(psb_dpk_) :: beta, x(:), y(:,:)
end subroutine psi_zsctmv
subroutine psi_zsctv(n,idx,x,beta,y)
import :: psb_ipk_, psb_mpk_, psb_dpk_
import
implicit none
integer(psb_mpk_) :: n
@@ -193,7 +192,7 @@ module psi_z_serial_mod
interface psi_exscan
subroutine psi_z_exscanv(n,x,info,shift)
import :: psb_ipk_, psb_mpk_, psb_dpk_
import
implicit none
integer(psb_ipk_), intent(in) :: n
complex(psb_dpk_), intent (inout) :: x(:)
base/modules/comm/psb_comm_mod.f90
+1
View File
@@ -31,6 +31,7 @@
!
module psb_comm_mod
use psb_i2_comm_a_mod
use psb_m_comm_a_mod
use psb_e_comm_a_mod
use psb_s_comm_a_mod
base/modules/comm/psb_i2_comm_mod.f90
+117
View File
@@ -0,0 +1,117 @@
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006-2018
! Salvatore Filippone
! Alfredo Buttari
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
module psb_i2_comm_mod
use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_lpk_, psb_epk_, psb_mpk_, psb_i2pk_
use psb_i2_vect_mod, only : psb_i2_vect_type, psb_i2_base_vect_type
use psb_i2_multivect_mod, only : psb_i2_multivect_type, psb_i2_base_multivect_type
interface psb_ovrl
subroutine psb_i2ovrl_vect(x,desc_a,info,work,update,mode)
import
implicit none
type(psb_i2_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_i2pk_), intent(inout), optional, target :: work(:)
integer(psb_ipk_), intent(in), optional :: update,mode
end subroutine psb_i2ovrl_vect
subroutine psb_i2ovrl_multivect(x,desc_a,info,work,update,mode)
import
implicit none
type(psb_i2_multivect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_i2pk_), intent(inout), optional, target :: work(:)
integer(psb_ipk_), intent(in), optional :: update,mode
end subroutine psb_i2ovrl_multivect
end interface psb_ovrl
interface psb_halo
subroutine psb_i2halo_vect(x,desc_a,info,work,tran,mode,data)
import
implicit none
type(psb_i2_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_i2pk_), target, optional, intent(inout) :: work(:)
integer(psb_ipk_), intent(in), optional :: mode,data
character, intent(in), optional :: tran
end subroutine psb_i2halo_vect
subroutine psb_i2halo_multivect(x,desc_a,info,work,tran,mode,data)
import
implicit none
type(psb_i2_multivect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_i2pk_), target, optional, intent(inout) :: work(:)
integer(psb_ipk_), intent(in), optional :: mode,data
character, intent(in), optional :: tran
end subroutine psb_i2halo_multivect
end interface psb_halo
interface psb_scatter
subroutine psb_i2scatter_vect(globx, locx, desc_a, info, root, mold)
import
implicit none
type(psb_i2_vect_type), intent(inout) :: locx
integer(psb_i2pk_), intent(in) :: globx(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: root
class(psb_i2_base_vect_type), intent(in), optional :: mold
end subroutine psb_i2scatter_vect
end interface psb_scatter
interface psb_gather
subroutine psb_i2gather_vect(globx, locx, desc_a, info, root)
import
implicit none
type(psb_i2_vect_type), intent(inout) :: locx
integer(psb_i2pk_), intent(out), allocatable :: globx(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: root
end subroutine psb_i2gather_vect
subroutine psb_i2gather_multivect(globx, locx, desc_a, info, root)
import
implicit none
type(psb_i2_multivect_type), intent(inout) :: locx
integer(psb_i2pk_), intent(out), allocatable :: globx(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: root
end subroutine psb_i2gather_multivect
end interface psb_gather
end module psb_i2_comm_mod
base/modules/comm/psb_i_comm_mod.f90
+1 -1
View File
@@ -30,7 +30,7 @@
!
!
module psb_i_comm_mod
use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_lpk_, psb_epk_, psb_mpk_
use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_lpk_, psb_epk_, psb_mpk_, psb_i2pk_
use psb_i_vect_mod, only : psb_i_vect_type, psb_i_base_vect_type
use psb_i_multivect_mod, only : psb_i_multivect_type, psb_i_base_multivect_type
base/modules/comm/psb_l_comm_mod.f90
+1 -1
View File
@@ -30,7 +30,7 @@
!
!
module psb_l_comm_mod
use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_lpk_, psb_epk_, psb_mpk_
use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_lpk_, psb_epk_, psb_mpk_, psb_i2pk_
use psb_l_vect_mod, only : psb_l_vect_type, psb_l_base_vect_type
use psb_l_multivect_mod, only : psb_l_multivect_type, psb_l_base_multivect_type
base/modules/comm/psi_i2_comm_v_mod.f90
+173
View File
@@ -0,0 +1,173 @@
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006-2018
! Salvatore Filippone
! Alfredo Buttari
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
module psi_i2_comm_v_mod
use psi_penv_mod, only : psb_ctxt_type
use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_mpk_, &
& psb_lpk_, psb_epk_, psb_i2pk_
use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_mpk_, psb_lpk_, psb_epk_, psb_i_base_vect_type
use psb_i2_base_vect_mod, only : psb_i2_base_vect_type
use psb_i2_base_multivect_mod, only : psb_i2_base_multivect_type
interface psi_swapdata
module subroutine psi_i2swapdata_vect(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
class(psb_i2_base_vect_type) :: y
integer(psb_i2pk_) :: beta
integer(psb_i2pk_),target :: work(:)
type(psb_desc_type), target :: desc_a
integer(psb_ipk_), optional :: data
end subroutine psi_i2swapdata_vect
module subroutine psi_i2swapdata_multivect(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
class(psb_i2_base_multivect_type) :: y
integer(psb_i2pk_) :: beta
integer(psb_i2pk_),target :: work(:)
type(psb_desc_type), target :: desc_a
integer(psb_ipk_), optional :: data
end subroutine psi_i2swapdata_multivect
module subroutine psi_i2swap_vidx_vect(ctxt,flag,beta,y,idx,&
& totxch,totsnd,totrcv,work,info)
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
class(psb_i2_base_vect_type) :: y
integer(psb_i2pk_) :: beta
integer(psb_i2pk_), target :: work(:)
class(psb_i_base_vect_type), intent(inout) :: idx
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
end subroutine psi_i2swap_vidx_vect
module subroutine psi_i2swap_vidx_multivect(ctxt,flag,beta,y,idx,&
& totxch,totsnd,totrcv,work,info)
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
class(psb_i2_base_multivect_type) :: y
integer(psb_i2pk_) :: beta
integer(psb_i2pk_), target :: work(:)
class(psb_i_base_vect_type), intent(inout) :: idx
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
end subroutine psi_i2swap_vidx_multivect
end interface psi_swapdata
interface psi_swaptran
module subroutine psi_i2swaptran_vect(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
class(psb_i2_base_vect_type) :: y
integer(psb_i2pk_) :: beta
integer(psb_i2pk_),target :: work(:)
type(psb_desc_type), target :: desc_a
integer(psb_ipk_), optional :: data
end subroutine psi_i2swaptran_vect
module subroutine psi_i2swaptran_multivect(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
class(psb_i2_base_multivect_type) :: y
integer(psb_i2pk_) :: beta
integer(psb_i2pk_),target :: work(:)
type(psb_desc_type), target :: desc_a
integer(psb_ipk_), optional :: data
end subroutine psi_i2swaptran_multivect
module subroutine psi_i2tran_vidx_vect(ctxt,flag,beta,y,idx,&
& totxch,totsnd,totrcv,work,info)
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
class(psb_i2_base_vect_type) :: y
integer(psb_i2pk_) :: beta
integer(psb_i2pk_), target :: work(:)
class(psb_i_base_vect_type), intent(inout) :: idx
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
end subroutine psi_i2tran_vidx_vect
module subroutine psi_i2tran_vidx_multivect(ctxt,flag,beta,y,idx,&
& totxch,totsnd,totrcv,work,info)
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
class(psb_i2_base_multivect_type) :: y
integer(psb_i2pk_) :: beta
integer(psb_i2pk_), target :: work(:)
class(psb_i_base_vect_type), intent(inout) :: idx
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
end subroutine psi_i2tran_vidx_multivect
end interface psi_swaptran
interface psi_ovrl_upd
module subroutine psi_i2ovrl_upd_vect(x,desc_a,update,info)
class(psb_i2_base_vect_type) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(in) :: update
integer(psb_ipk_), intent(out) :: info
end subroutine psi_i2ovrl_upd_vect
module subroutine psi_i2ovrl_upd_multivect(x,desc_a,update,info)
class(psb_i2_base_multivect_type) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(in) :: update
integer(psb_ipk_), intent(out) :: info
end subroutine psi_i2ovrl_upd_multivect
end interface psi_ovrl_upd
interface psi_ovrl_save
module subroutine psi_i2ovrl_save_vect(x,xs,desc_a,info)
class(psb_i2_base_vect_type) :: x
integer(psb_i2pk_), allocatable :: xs(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psi_i2ovrl_save_vect
module subroutine psi_i2ovrl_save_multivect(x,xs,desc_a,info)
class(psb_i2_base_multivect_type) :: x
integer(psb_i2pk_), allocatable :: xs(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psi_i2ovrl_save_multivect
end interface psi_ovrl_save
interface psi_ovrl_restore
module subroutine psi_i2ovrl_restr_vect(x,xs,desc_a,info)
class(psb_i2_base_vect_type) :: x
integer(psb_i2pk_) :: xs(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psi_i2ovrl_restr_vect
module subroutine psi_i2ovrl_restr_multivect(x,xs,desc_a,info)
class(psb_i2_base_multivect_type) :: x
integer(psb_i2pk_) :: xs(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psi_i2ovrl_restr_multivect
end interface psi_ovrl_restore
end module psi_i2_comm_v_mod
base/modules/penv/psi_collective_mod.F90
+1
View File
@@ -31,6 +31,7 @@
!
module psi_collective_mod
use psi_penv_mod
use psi_i2_collective_mod
use psi_m_collective_mod
use psi_e_collective_mod
use psi_s_collective_mod
base/modules/penv/psi_p2p_mod.F90
+1
View File
@@ -33,6 +33,7 @@
module psi_p2p_mod
use psi_penv_mod
use psi_i2_p2p_mod
use psi_m_p2p_mod
use psi_e_p2p_mod
use psi_s_p2p_mod
base/modules/psb_realloc_mod.F90
+1
View File
@@ -31,6 +31,7 @@
!
module psb_realloc_mod
use psb_const_mod
use psb_i2_realloc_mod
use psb_m_realloc_mod
use psb_e_realloc_mod
use psb_s_realloc_mod
base/modules/psi_i2_mod.F90
+44
View File
@@ -0,0 +1,44 @@
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006-2018
! Salvatore Filippone
! Alfredo Buttari
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
module psi_i2_mod
use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_mpk_, psb_epk_, &
& psb_lpk_, psb_i2pk_
use psi_m_comm_a_mod
use psi_e_comm_a_mod
use psi_i2_comm_a_mod
use psb_i2_base_vect_mod, only : psb_i2_base_vect_type
use psb_i2_base_multivect_mod, only : psb_i2_base_multivect_type
use psi_i2_comm_v_mod
end module psi_i2_mod
base/modules/psi_i_mod.F90
+1 -1
View File
@@ -31,7 +31,7 @@
!
module psi_i_mod
use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_mpk_, psb_epk_, &
use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_mpk_, psb_epk_, &
& psb_lpk_, psb_i2pk_
use psi_m_comm_a_mod
use psi_e_comm_a_mod
base/modules/psi_l_mod.F90
+1 -1
View File
@@ -31,7 +31,7 @@
!
module psi_l_mod
use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_mpk_, psb_epk_, &
use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_mpk_, psb_epk_, &
& psb_lpk_, psb_i2pk_
use psi_m_comm_a_mod
use psi_e_comm_a_mod
base/modules/psi_mod.f90
+1
View File
@@ -36,6 +36,7 @@ module psi_mod
use psb_const_mod
use psb_error_mod
use psb_penv_mod
use psi_i2_mod
use psi_i_mod
use psi_l_mod
use psi_s_mod
base/modules/serial/psb_i2_base_vect_mod.F90
+2567
View File
File diff suppressed because it is too large Load Diff
base/modules/serial/psb_i2_vect_mod.F90
+1271
View File
File diff suppressed because it is too large Load Diff
base/modules/serial/psb_vect_mod.f90
+1
View File
@@ -1,4 +1,5 @@
module psb_vect_mod
use psb_i2_vect_mod
use psb_i_vect_mod
use psb_l_vect_mod
use psb_s_vect_mod
base/modules/tools/psb_tools_mod.f90
+1
View File
@@ -31,6 +31,7 @@
!
module psb_tools_mod
use psb_cd_tools_mod
use psb_i2_tools_a_mod
use psb_e_tools_a_mod
use psb_m_tools_a_mod
use psb_s_tools_a_mod
base/serial/Makefile
+1 -1
View File
@@ -1,7 +1,7 @@
include ../../Make.inc
FOBJS = psb_lsame.o psi_m_serial_impl.o psi_e_serial_impl.o \
FOBJS = psb_lsame.o psi_m_serial_impl.o psi_e_serial_impl.o psi_i2_serial_impl.o \
psi_s_serial_impl.o psi_d_serial_impl.o \
psi_c_serial_impl.o psi_z_serial_impl.o \
psb_srwextd.o psb_drwextd.o psb_crwextd.o psb_zrwextd.o \
base/serial/sort/Makefile
+2 -1
View File
@@ -3,6 +3,7 @@ include ../../../Make.inc
#
# The object files
#
I2OBJS=psb_i2_hsort_impl.o psb_i2_isort_impl.o psb_i2_msort_impl.o psb_i2_qsort_impl.o
IOBJS=psb_m_hsort_impl.o psb_m_isort_impl.o psb_m_msort_impl.o psb_m_qsort_impl.o
LOBJS=psb_e_hsort_impl.o psb_e_isort_impl.o psb_e_msort_impl.o psb_e_qsort_impl.o
SOBJS=psb_s_hsort_impl.o psb_s_isort_impl.o psb_s_msort_impl.o psb_s_qsort_impl.o
@@ -10,7 +11,7 @@ DOBJS=psb_d_hsort_impl.o psb_d_isort_impl.o psb_d_msort_impl.o psb_d_qsort_impl.
COBJS=psb_c_hsort_impl.o psb_c_isort_impl.o psb_c_msort_impl.o psb_c_qsort_impl.o
ZOBJS=psb_z_hsort_impl.o psb_z_isort_impl.o psb_z_msort_impl.o psb_z_qsort_impl.o
OBJS=$(SOBJS) $(DOBJS) $(COBJS) $(ZOBJS) $(IOBJS) $(LOBJS)
OBJS=$(SOBJS) $(DOBJS) $(COBJS) $(ZOBJS) $(I2OBJS) $(IOBJS) $(LOBJS)
#
# Where the library should go, and how it is called.
base/serial/sort/psb_i2_hsort_impl.f90
+721
View File
@@ -0,0 +1,721 @@
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006-2018
! Salvatore Filippone
! Alfredo Buttari
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
! The merge-sort and quicksort routines are implemented in the
! serial/aux directory
! References:
! D. Knuth
! The Art of Computer Programming, vol. 3
! Addison-Wesley
!
! Aho, Hopcroft, Ullman
! Data Structures and Algorithms
! Addison-Wesley
!
subroutine psb_i2hsort(x,ix,dir,flag,reord)
use psb_sort_mod, psb_protect_name => psb_i2hsort
use psb_error_mod
implicit none
integer(psb_i2pk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: flag_, err_act, info, reord_
integer(psb_ipk_) :: n, i, l, dir_
integer(psb_i2pk_) :: key
integer(psb_ipk_) :: index
integer(psb_i2pk_), allocatable :: tx(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
name='psb_hsort'
call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(flag)) then
flag_ = flag
else
flag_ = psb_sort_ovw_idx_
end if
select case(flag_)
case( psb_sort_ovw_idx_, psb_sort_keep_idx_)
! OK keep going
case default
ierr(1) = 4; ierr(2) = flag_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
if (present(dir)) then
dir_ = dir
else
dir_= psb_sort_up_
end if
select case(dir_)
case(psb_sort_up_,psb_sort_down_)
! OK
case (psb_asort_up_,psb_asort_down_)
! OK
case default
ierr(1) = 3; ierr(2) = dir_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
n = size(x)
!
! Dirty trick to sort with heaps: if we want
! to sort in place upwards, first we set up a heap so that
! we can easily get the LARGEST element, then we take it out
! and put it in the last entry, and so on.
! So, we invert dir_
!
dir_ = -dir_
if (present(ix)) then
if (size(ix) < n) then
ierr(1) = 2; ierr(2) = size(ix);
call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=ierr)
goto 9999
end if
if (flag_ == psb_sort_ovw_idx_) then
do i=1, n
ix(i) = i
end do
end if
select case(reord_)
case (psb_sort_reord_x_)
l = 0
do i=1, n
key = x(i)
index = ix(i)
call psi_idx_insert_heap(key,index,l,x,ix,dir_,info)
if (l /= i) then
write(psb_err_unit,*) 'Mismatch while heapifying ! '
end if
end do
do i=n, 2, -1
call psi_idx_heap_get_first(key,index,l,x,ix,dir_,info)
if (l /= i-1) then
write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i
end if
x(i) = key
ix(i) = index
end do
case(psb_sort_noreord_x_)
tx = x
l = 0
do i=1, n
key = tx(i)
index = ix(i)
call psi_idx_insert_heap(key,index,l,tx,ix,dir_,info)
if (l /= i) then
write(psb_err_unit,*) 'Mismatch while heapifying ! '
end if
end do
do i=n, 2, -1
call psi_idx_heap_get_first(key,index,l,tx,ix,dir_,info)
if (l /= i-1) then
write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i
end if
tx(i) = key
ix(i) = index
end do
end select
else if (.not.present(ix)) then
select case(reord_)
case (psb_sort_reord_x_)
!OK
case default
ierr(1) = 5; ierr(2) = reord_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
l = 0
do i=1, n
key = x(i)
call psi_insert_heap(key,l,x,dir_,info)
if (l /= i) then
write(psb_err_unit,*) 'Mismatch while heapifying ! ',l,i
end if
end do
do i=n, 2, -1
call psi_i2_heap_get_first(key,l,x,dir_,info)
if (l /= i-1) then
write(psb_err_unit,*) 'Mismatch while pulling out of heap ',l,i
end if
x(i) = key
end do
end if
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_i2hsort
!
! These are packaged so that they can be used to implement
! a heapsort.
!
!
! Programming note:
! In the implementation of the heap_get_first function
! we have code like this
!
! if ( ( heap(2*i) < heap(2*i+1) ) .or.&
! & (2*i == last)) then
! j = 2*i
! else
! j = 2*i + 1
! end if
!
! It looks like the 2*i+1 could overflow the array, but this
! is not true because there is a guard statement
! if (i>last/2) exit
! and because last has just been reduced by 1 when defining the return value,
! therefore 2*i+1 may be greater than the current value of last,
! but cannot be greater than the value of last when the routine was entered
! hence it is safe.
!
!
!
subroutine psi_i2_insert_heap(key,last,heap,dir,info)
use psb_sort_mod, psb_protect_name => psi_i2_insert_heap
implicit none
!
! Input:
! key: the new value
! last: pointer to the last occupied element in heap
! heap: the heap
! dir: sorting direction
integer(psb_i2pk_), intent(in) :: key
integer(psb_ipk_), intent(in) :: dir
integer(psb_i2pk_), intent(inout) :: heap(:)
integer(psb_ipk_), intent(inout) :: last
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, i2
integer(psb_i2pk_) :: temp
info = psb_success_
if (last < 0) then
write(psb_err_unit,*) 'Invalid last in heap ',last
info = last
return
endif
last = last + 1
if (last > size(heap)) then
write(psb_err_unit,*) 'out of bounds '
info = -1
return
end if
i = last
heap(i) = key
select case(dir)
case (psb_sort_up_)
do
if (i<=1) exit
i2 = i/2
if (heap(i) < heap(i2)) then
temp = heap(i)
heap(i) = heap(i2)
heap(i2) = temp
i = i2
else
exit
end if
end do
case (psb_sort_down_)
do
if (i<=1) exit
i2 = i/2
if (heap(i) > heap(i2)) then
temp = heap(i)
heap(i) = heap(i2)
heap(i2) = temp
i = i2
else
exit
end if
end do
case (psb_asort_up_)
do
if (i<=1) exit
i2 = i/2
if (abs(heap(i)) < abs(heap(i2))) then
temp = heap(i)
heap(i) = heap(i2)
heap(i2) = temp
i = i2
else
exit
end if
end do
case (psb_asort_down_)
do
if (i<=1) exit
i2 = i/2
if (abs(heap(i)) > abs(heap(i2))) then
temp = heap(i)
heap(i) = heap(i2)
heap(i2) = temp
i = i2
else
exit
end if
end do
case default
write(psb_err_unit,*) 'Invalid direction in heap ',dir
end select
return
end subroutine psi_i2_insert_heap
subroutine psi_i2_heap_get_first(key,last,heap,dir,info)
use psb_sort_mod, psb_protect_name => psi_i2_heap_get_first
implicit none
integer(psb_i2pk_), intent(inout) :: key
integer(psb_ipk_), intent(inout) :: last
integer(psb_ipk_), intent(in) :: dir
integer(psb_i2pk_), intent(inout) :: heap(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, j
integer(psb_i2pk_) :: temp
info = psb_success_
if (last <= 0) then
key = 0
info = -1
return
endif
key = heap(1)
heap(1) = heap(last)
last = last - 1
select case(dir)
case (psb_sort_up_)
i = 1
do
if (i > (last/2)) exit
if ( (heap(2*i) < heap(2*i+1)) .or.&
& (2*i == last)) then
j = 2*i
else
j = 2*i + 1
end if
if (heap(i) > heap(j)) then
temp = heap(i)
heap(i) = heap(j)
heap(j) = temp
i = j
else
exit
end if
end do
case (psb_sort_down_)
i = 1
do
if (i > (last/2)) exit
if ( (heap(2*i) > heap(2*i+1)) .or.&
& (2*i == last)) then
j = 2*i
else
j = 2*i + 1
end if
if (heap(i) < heap(j)) then
temp = heap(i)
heap(i) = heap(j)
heap(j) = temp
i = j
else
exit
end if
end do
case (psb_asort_up_)
i = 1
do
if (i > (last/2)) exit
if ( (abs(heap(2*i)) < abs(heap(2*i+1))) .or.&
& (2*i == last)) then
j = 2*i
else
j = 2*i + 1
end if
if (abs(heap(i)) > abs(heap(j))) then
temp = heap(i)
heap(i) = heap(j)
heap(j) = temp
i = j
else
exit
end if
end do
case (psb_asort_down_)
i = 1
do
if (i > (last/2)) exit
if ( (abs(heap(2*i)) > abs(heap(2*i+1))) .or.&
& (2*i == last)) then
j = 2*i
else
j = 2*i + 1
end if
if (abs(heap(i)) < abs(heap(j))) then
temp = heap(i)
heap(i) = heap(j)
heap(j) = temp
i = j
else
exit
end if
end do
case default
write(psb_err_unit,*) 'Invalid direction in heap ',dir
end select
return
end subroutine psi_i2_heap_get_first
subroutine psi_i2_idx_insert_heap(key,index,last,heap,idxs,dir,info)
use psb_sort_mod, psb_protect_name => psi_i2_idx_insert_heap
implicit none
!
! Input:
! key: the new value
! index: the new index
! last: pointer to the last occupied element in heap
! heap: the heap
! idxs: the indices
! dir: sorting direction
integer(psb_i2pk_), intent(in) :: key
integer(psb_ipk_), intent(in) :: index,dir
integer(psb_i2pk_), intent(inout) :: heap(:)
integer(psb_ipk_), intent(inout) :: idxs(:),last
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, i2, itemp
integer(psb_i2pk_) :: temp
info = psb_success_
if (last < 0) then
write(psb_err_unit,*) 'Invalid last in heap ',last
info = last
return
endif
last = last + 1
if (last > size(heap)) then
write(psb_err_unit,*) 'out of bounds '
info = -1
return
end if
i = last
heap(i) = key
idxs(i) = index
select case(dir)
case (psb_sort_up_)
do
if (i<=1) exit
i2 = i/2
if (heap(i) < heap(i2)) then
itemp = idxs(i)
idxs(i) = idxs(i2)
idxs(i2) = itemp
temp = heap(i)
heap(i) = heap(i2)
heap(i2) = temp
i = i2
else
exit
end if
end do
case (psb_sort_down_)
do
if (i<=1) exit
i2 = i/2
if (heap(i) > heap(i2)) then
itemp = idxs(i)
idxs(i) = idxs(i2)
idxs(i2) = itemp
temp = heap(i)
heap(i) = heap(i2)
heap(i2) = temp
i = i2
else
exit
end if
end do
case (psb_asort_up_)
do
if (i<=1) exit
i2 = i/2
if (abs(heap(i)) < abs(heap(i2))) then
itemp = idxs(i)
idxs(i) = idxs(i2)
idxs(i2) = itemp
temp = heap(i)
heap(i) = heap(i2)
heap(i2) = temp
i = i2
else
exit
end if
end do
case (psb_asort_down_)
do
if (i<=1) exit
i2 = i/2
if (abs(heap(i)) > abs(heap(i2))) then
itemp = idxs(i)
idxs(i) = idxs(i2)
idxs(i2) = itemp
temp = heap(i)
heap(i) = heap(i2)
heap(i2) = temp
i = i2
else
exit
end if
end do
case default
write(psb_err_unit,*) 'Invalid direction in heap ',dir
end select
return
end subroutine psi_i2_idx_insert_heap
subroutine psi_i2_idx_heap_get_first(key,index,last,heap,idxs,dir,info)
use psb_sort_mod, psb_protect_name => psi_i2_idx_heap_get_first
implicit none
integer(psb_i2pk_), intent(inout) :: key
integer(psb_i2pk_), intent(inout) :: heap(:)
integer(psb_ipk_), intent(out) :: index
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(inout) :: last,idxs(:)
integer(psb_ipk_), intent(in) :: dir
integer(psb_ipk_) :: i, j,itemp
integer(psb_i2pk_) :: temp
info = psb_success_
if (last <= 0) then
key = 0
index = 0
info = -1
return
endif
key = heap(1)
index = idxs(1)
heap(1) = heap(last)
idxs(1) = idxs(last)
last = last - 1
select case(dir)
case (psb_sort_up_)
i = 1
do
if (i > (last/2)) exit
if ( (heap(2*i) < heap(2*i+1)) .or.&
& (2*i == last)) then
j = 2*i
else
j = 2*i + 1
end if
if (heap(i) > heap(j)) then
itemp = idxs(i)
idxs(i) = idxs(j)
idxs(j) = itemp
temp = heap(i)
heap(i) = heap(j)
heap(j) = temp
i = j
else
exit
end if
end do
case (psb_sort_down_)
i = 1
do
if (i > (last/2)) exit
if ( (heap(2*i) > heap(2*i+1)) .or.&
& (2*i == last)) then
j = 2*i
else
j = 2*i + 1
end if
if (heap(i) < heap(j)) then
itemp = idxs(i)
idxs(i) = idxs(j)
idxs(j) = itemp
temp = heap(i)
heap(i) = heap(j)
heap(j) = temp
i = j
else
exit
end if
end do
case (psb_asort_up_)
i = 1
do
if (i > (last/2)) exit
if ( (abs(heap(2*i)) < abs(heap(2*i+1))) .or.&
& (2*i == last)) then
j = 2*i
else
j = 2*i + 1
end if
if (abs(heap(i)) > abs(heap(j))) then
itemp = idxs(i)
idxs(i) = idxs(j)
idxs(j) = itemp
temp = heap(i)
heap(i) = heap(j)
heap(j) = temp
i = j
else
exit
end if
end do
case (psb_asort_down_)
i = 1
do
if (i > (last/2)) exit
if ( (abs(heap(2*i)) > abs(heap(2*i+1))) .or.&
& (2*i == last)) then
j = 2*i
else
j = 2*i + 1
end if
if (abs(heap(i)) < abs(heap(j))) then
itemp = idxs(i)
idxs(i) = idxs(j)
idxs(j) = itemp
temp = heap(i)
heap(i) = heap(j)
heap(j) = temp
i = j
else
exit
end if
end do
case default
write(psb_err_unit,*) 'Invalid direction in heap ',dir
end select
return
end subroutine psi_i2_idx_heap_get_first
base/serial/sort/psb_i2_isort_impl.f90
+378
View File
@@ -0,0 +1,378 @@
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006-2018
! Salvatore Filippone
! Alfredo Buttari
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
! The insertion sort routines
! References:
! D. Knuth
! The Art of Computer Programming, vol. 3
! Addison-Wesley
!
! Aho, Hopcroft, Ullman
! Data Structures and Algorithms
! Addison-Wesley
!
subroutine psb_i2isort(x,ix,dir,flag,reord)
use psb_sort_mod, psb_protect_name => psb_i2isort
use psb_error_mod
implicit none
integer(psb_i2pk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag,reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: dir_, flag_, err_act, reord_
integer(psb_ipk_) :: n, i
integer(psb_i2pk_), allocatable :: tx(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
name='psb_i2isort'
call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(flag)) then
flag_ = flag
else
flag_ = psb_sort_ovw_idx_
end if
select case(flag_)
case( psb_sort_ovw_idx_, psb_sort_keep_idx_)
! OK keep going
case default
ierr(1) = 4; ierr(2) = flag_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
if (present(dir)) then
dir_ = dir
else
dir_= psb_sort_up_
end if
n = size(x)
if (present(ix)) then
if (size(ix) < n) then
ierr(1) = 2; ierr(2) = size(ix);
call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=ierr)
goto 9999
end if
if (flag_==psb_sort_ovw_idx_) then
do i=1,n
ix(i) = i
end do
end if
select case(reord_)
case (psb_sort_reord_x_)
select case(dir_)
case (psb_sort_up_)
call psi_i2isrx_up(n,x,ix)
case (psb_sort_down_)
call psi_i2isrx_dw(n,x,ix)
case (psb_asort_up_)
call psi_i2aisrx_up(n,x,ix)
case (psb_asort_down_)
call psi_i2aisrx_dw(n,x,ix)
case default
ierr(1) = 3; ierr(2) = dir_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
case(psb_sort_noreord_x_)
tx = x
select case(dir_)
case (psb_sort_up_)
call psi_i2isrx_up(n,tx,ix)
case (psb_sort_down_)
call psi_i2isrx_dw(n,tx,ix)
case (psb_asort_up_)
call psi_i2aisrx_up(n,tx,ix)
case (psb_asort_down_)
call psi_i2aisrx_dw(n,tx,ix)
case default
ierr(1) = 3; ierr(2) = dir_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
case default
ierr(1) = 5; ierr(2) = reord_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
else
select case(reord_)
case (psb_sort_reord_x_)
!OK
case default
ierr(1) = 5; ierr(2) = reord_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
select case(dir_)
case (psb_sort_up_)
call psi_i2isr_up(n,x)
case (psb_sort_down_)
call psi_i2isr_dw(n,x)
case (psb_asort_up_)
call psi_i2aisr_up(n,x)
case (psb_asort_down_)
call psi_i2aisr_dw(n,x)
case default
ierr(1) = 3; ierr(2) = dir_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
end if
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_i2isort
subroutine psi_i2isrx_up(n,x,idx)
use psb_sort_mod, psb_protect_name => psi_i2isrx_up
use psb_error_mod
implicit none
integer(psb_i2pk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
integer(psb_i2pk_) :: xx
do j=n-1,1,-1
if (x(j+1) < x(j)) then
xx = x(j)
ix = idx(j)
i=j+1
do
x(i-1) = x(i)
idx(i-1) = idx(i)
i = i+1
if (i>n) exit
if (x(i) >= xx) exit
end do
x(i-1) = xx
idx(i-1) = ix
endif
enddo
end subroutine psi_i2isrx_up
subroutine psi_i2isrx_dw(n,x,idx)
use psb_sort_mod, psb_protect_name => psi_i2isrx_dw
use psb_error_mod
implicit none
integer(psb_i2pk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
integer(psb_i2pk_) :: xx
do j=n-1,1,-1
if (x(j+1) > x(j)) then
xx = x(j)
ix = idx(j)
i=j+1
do
x(i-1) = x(i)
idx(i-1) = idx(i)
i = i+1
if (i>n) exit
if (x(i) <= xx) exit
end do
x(i-1) = xx
idx(i-1) = ix
endif
enddo
end subroutine psi_i2isrx_dw
subroutine psi_i2isr_up(n,x)
use psb_sort_mod, psb_protect_name => psi_i2isr_up
use psb_error_mod
implicit none
integer(psb_i2pk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j
integer(psb_i2pk_) :: xx
do j=n-1,1,-1
if (x(j+1) < x(j)) then
xx = x(j)
i=j+1
do
x(i-1) = x(i)
i = i+1
if (i>n) exit
if (x(i) >= xx) exit
end do
x(i-1) = xx
endif
enddo
end subroutine psi_i2isr_up
subroutine psi_i2isr_dw(n,x)
use psb_sort_mod, psb_protect_name => psi_i2isr_dw
use psb_error_mod
implicit none
integer(psb_i2pk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j
integer(psb_i2pk_) :: xx
do j=n-1,1,-1
if (x(j+1) > x(j)) then
xx = x(j)
i=j+1
do
x(i-1) = x(i)
i = i+1
if (i>n) exit
if (x(i) <= xx) exit
end do
x(i-1) = xx
endif
enddo
end subroutine psi_i2isr_dw
subroutine psi_i2aisrx_up(n,x,idx)
use psb_sort_mod, psb_protect_name => psi_i2aisrx_up
use psb_error_mod
implicit none
integer(psb_i2pk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
integer(psb_i2pk_) :: xx
do j=n-1,1,-1
if (abs(x(j+1)) < abs(x(j))) then
xx = x(j)
ix = idx(j)
i=j+1
do
x(i-1) = x(i)
idx(i-1) = idx(i)
i = i+1
if (i>n) exit
if (abs(x(i)) >= abs(xx)) exit
end do
x(i-1) = xx
idx(i-1) = ix
endif
enddo
end subroutine psi_i2aisrx_up
subroutine psi_i2aisrx_dw(n,x,idx)
use psb_sort_mod, psb_protect_name => psi_i2aisrx_dw
use psb_error_mod
implicit none
integer(psb_i2pk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
integer(psb_i2pk_) :: xx
do j=n-1,1,-1
if (abs(x(j+1)) > abs(x(j))) then
xx = x(j)
ix = idx(j)
i=j+1
do
x(i-1) = x(i)
idx(i-1) = idx(i)
i = i+1
if (i>n) exit
if (abs(x(i)) <= abs(xx)) exit
end do
x(i-1) = xx
idx(i-1) = ix
endif
enddo
end subroutine psi_i2aisrx_dw
subroutine psi_i2aisr_up(n,x)
use psb_sort_mod, psb_protect_name => psi_i2aisr_up
use psb_error_mod
implicit none
integer(psb_i2pk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j
integer(psb_i2pk_) :: xx
do j=n-1,1,-1
if (abs(x(j+1)) < abs(x(j))) then
xx = x(j)
i=j+1
do
x(i-1) = x(i)
i = i+1
if (i>n) exit
if (abs(x(i)) >= abs(xx)) exit
end do
x(i-1) = xx
endif
enddo
end subroutine psi_i2aisr_up
subroutine psi_i2aisr_dw(n,x)
use psb_sort_mod, psb_protect_name => psi_i2aisr_dw
use psb_error_mod
implicit none
integer(psb_i2pk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j
integer(psb_i2pk_) :: xx
do j=n-1,1,-1
if (abs(x(j+1)) > abs(x(j))) then
xx = x(j)
i=j+1
do
x(i-1) = x(i)
i = i+1
if (i>n) exit
if (abs(x(i)) <= abs(xx)) exit
end do
x(i-1) = xx
endif
enddo
end subroutine psi_i2aisr_dw
base/serial/sort/psb_i2_msort_impl.f90
+667
View File
@@ -0,0 +1,667 @@
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006-2018
! Salvatore Filippone
! Alfredo Buttari
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
! The merge-sort routines
! References:
! D. Knuth
! The Art of Computer Programming, vol. 3
! Addison-Wesley
!
! Aho, Hopcroft, Ullman
! Data Structures and Algorithms
! Addison-Wesley
!
logical function psb_i2isaperm(n,eip)
use psb_sort_mod, psb_protect_name => psb_i2isaperm
implicit none
integer(psb_i2pk_), intent(in) :: n
integer(psb_i2pk_), intent(in) :: eip(n)
integer(psb_i2pk_), allocatable :: ip(:)
integer(psb_i2pk_) :: i,j,m, info
psb_i2isaperm = .true.
if (n <= 0) return
allocate(ip(n), stat=info)
if (info /= psb_success_) return
!
! sanity check first
!
do i=1, n
ip(i) = eip(i)
if ((ip(i) < 1).or.(ip(i) > n)) then
write(psb_err_unit,*) 'Out of bounds in isaperm' ,ip(i), n
psb_i2isaperm = .false.
return
endif
enddo
!
! now work through the cycles, by marking each successive item as negative.
! no cycle should intersect with any other, hence the >= 1 check.
!
do m = 1, n
i = ip(m)
if (i < 0) then
ip(m) = -i
else if (i /= m) then
j = ip(i)
ip(i) = -j
i = j
do while ((j >= 1).and.(j /= m))
j = ip(i)
ip(i) = -j
i = j
enddo
ip(m) = abs(ip(m))
if (j /= m) then
psb_i2isaperm = .false.
goto 9999
endif
end if
enddo
9999 continue
return
end function psb_i2isaperm
subroutine psb_i2msort_u(x,nout,dir)
use psb_sort_mod, psb_protect_name => psb_i2msort_u
use psb_error_mod
implicit none
integer(psb_i2pk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: nout
integer(psb_ipk_), optional, intent(in) :: dir
integer(psb_ipk_) :: n, k
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
name='psb_msort_u'
call psb_erractionsave(err_act)
n = size(x)
call psb_msort(x,dir=dir)
nout = min(1,n)
do k=2,n
if (x(k) /= x(nout)) then
nout = nout + 1
x(nout) = x(k)
endif
enddo
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_i2msort_u
subroutine psb_i2msort(x,ix,dir,flag,reord)
use psb_sort_mod, psb_protect_name => psb_i2msort
use psb_error_mod
use psb_ip_reord_mod
implicit none
integer(psb_i2pk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag, reord
integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: dir_, flag_, n, err_act, reord_
integer(psb_ipk_), allocatable :: iaux(:)
integer(psb_ipk_) :: iret, info, i
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
name='psb_i2msort'
call psb_erractionsave(err_act)
if (present(reord)) then
reord_ = reord
else
reord_= psb_sort_reord_x_
end if
if (present(dir)) then
dir_ = dir
else
dir_= psb_sort_up_
end if
select case(dir_)
case( psb_sort_up_, psb_sort_down_, psb_asort_up_, psb_asort_down_)
! OK keep going
case default
ierr(1) = 3; ierr(2) = dir_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
n = size(x)
if (present(ix)) then
if (size(ix) < n) then
ierr(1) = 2; ierr(2) = size(ix);
call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=ierr)
goto 9999
end if
if (present(flag)) then
flag_ = flag
else
flag_ = psb_sort_ovw_idx_
end if
select case(flag_)
case(psb_sort_ovw_idx_)
do i=1,n
ix(i) = i
end do
case (psb_sort_keep_idx_)
! OK keep going
case default
ierr(1) = 4; ierr(2) = flag_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
end if
allocate(iaux(0:n+1),stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,r_name='psb_i2_msort')
goto 9999
endif
select case(dir_)
case (psb_sort_up_)
call psi_i2_msort_up(n,x,iaux,iret)
case (psb_sort_down_)
call psi_i2_msort_dw(n,x,iaux,iret)
case (psb_asort_up_)
call psi_i2_amsort_up(n,x,iaux,iret)
case (psb_asort_down_)
call psi_i2_amsort_dw(n,x,iaux,iret)
end select
!
! Do the actual reordering, since the inner routines
! only provide linked pointers.
!
if (iret == 0 ) then
select case(reord_)
case(psb_sort_reord_x_)
if (present(ix)) then
call psb_ip_reord(n,x,ix,iaux)
else
call psb_ip_reord(n,x,iaux)
end if
case(psb_sort_noreord_x_)
if (present(ix)) then
call psb_ip_reord(n,ix,iaux)
else
call psb_errpush(psb_err_no_optional_arg_,name,a_err="ix")
goto 9999
end if
case default
ierr(1) = 5; ierr(2) = reord_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
end if
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_i2msort
subroutine psi_i2_msort_up(n,k,l,iret)
use psb_const_mod
implicit none
integer(psb_ipk_) :: n, iret
integer(psb_i2pk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
!
integer(psb_ipk_) :: p,q,s,t
! ..
iret = 0
! first step: we are preparing ordered sublists, exploiting
! what order was already in the input data; negative links
! mark the end of the sublists
l(0) = 1
t = n + 1
do p = 1,n - 1
if (k(p) <= k(p+1)) then
l(p) = p + 1
else
l(t) = - (p+1)
t = p
end if
end do
l(t) = 0
l(n) = 0
! see if the input was already sorted
if (l(n+1) == 0) then
iret = 1
return
else
l(n+1) = abs(l(n+1))
end if
mergepass: do
! otherwise, begin a pass through the list.
! throughout all the subroutine we have:
! p, q: pointing to the sublists being merged
! s: pointing to the most recently processed record
! t: pointing to the end of previously completed sublist
s = 0
t = n + 1
p = l(s)
q = l(t)
if (q == 0) exit mergepass
outer: do
if (k(p) > k(q)) then
l(s) = sign(q,l(s))
s = q
q = l(q)
if (q > 0) then
do
if (k(p) <= k(q)) cycle outer
s = q
q = l(q)
if (q <= 0) exit
end do
end if
l(s) = p
s = t
do
t = p
p = l(p)
if (p <= 0) exit
end do
else
l(s) = sign(p,l(s))
s = p
p = l(p)
if (p>0) then
do
if (k(p) > k(q)) cycle outer
s = p
p = l(p)
if (p <= 0) exit
end do
end if
! otherwise, one sublist ended, and we append to it the rest
! of the other one.
l(s) = q
s = t
do
t = q
q = l(q)
if (q <= 0) exit
end do
end if
p = -p
q = -q
if (q == 0) then
l(s) = sign(p,l(s))
l(t) = 0
exit outer
end if
end do outer
end do mergepass
end subroutine psi_i2_msort_up
subroutine psi_i2_msort_dw(n,k,l,iret)
use psb_const_mod
implicit none
integer(psb_ipk_) :: n, iret
integer(psb_i2pk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
!
integer(psb_ipk_) :: p,q,s,t
! ..
iret = 0
! first step: we are preparing ordered sublists, exploiting
! what order was already in the input data; negative links
! mark the end of the sublists
l(0) = 1
t = n + 1
do p = 1,n - 1
if (k(p) >= k(p+1)) then
l(p) = p + 1
else
l(t) = - (p+1)
t = p
end if
end do
l(t) = 0
l(n) = 0
! see if the input was already sorted
if (l(n+1) == 0) then
iret = 1
return
else
l(n+1) = abs(l(n+1))
end if
mergepass: do
! otherwise, begin a pass through the list.
! throughout all the subroutine we have:
! p, q: pointing to the sublists being merged
! s: pointing to the most recently processed record
! t: pointing to the end of previously completed sublist
s = 0
t = n + 1
p = l(s)
q = l(t)
if (q == 0) exit mergepass
outer: do
if (k(p) < k(q)) then
l(s) = sign(q,l(s))
s = q
q = l(q)
if (q > 0) then
do
if (k(p) >= k(q)) cycle outer
s = q
q = l(q)
if (q <= 0) exit
end do
end if
l(s) = p
s = t
do
t = p
p = l(p)
if (p <= 0) exit
end do
else
l(s) = sign(p,l(s))
s = p
p = l(p)
if (p>0) then
do
if (k(p) < k(q)) cycle outer
s = p
p = l(p)
if (p <= 0) exit
end do
end if
! otherwise, one sublist ended, and we append to it the rest
! of the other one.
l(s) = q
s = t
do
t = q
q = l(q)
if (q <= 0) exit
end do
end if
p = -p
q = -q
if (q == 0) then
l(s) = sign(p,l(s))
l(t) = 0
exit outer
end if
end do outer
end do mergepass
end subroutine psi_i2_msort_dw
subroutine psi_i2_amsort_up(n,k,l,iret)
use psb_const_mod
implicit none
integer(psb_ipk_) :: n, iret
integer(psb_i2pk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
!
integer(psb_ipk_) :: p,q,s,t
! ..
iret = 0
! first step: we are preparing ordered sublists, exploiting
! what order was already in the input data; negative links
! mark the end of the sublists
l(0) = 1
t = n + 1
do p = 1,n - 1
if (abs(k(p)) <= abs(k(p+1))) then
l(p) = p + 1
else
l(t) = - (p+1)
t = p
end if
end do
l(t) = 0
l(n) = 0
! see if the input was already sorted
if (l(n+1) == 0) then
iret = 1
return
else
l(n+1) = abs(l(n+1))
end if
mergepass: do
! otherwise, begin a pass through the list.
! throughout all the subroutine we have:
! p, q: pointing to the sublists being merged
! s: pointing to the most recently processed record
! t: pointing to the end of previously completed sublist
s = 0
t = n + 1
p = l(s)
q = l(t)
if (q == 0) exit mergepass
outer: do
if (abs(k(p)) > abs(k(q))) then
l(s) = sign(q,l(s))
s = q
q = l(q)
if (q > 0) then
do
if (abs(k(p)) <= abs(k(q))) cycle outer
s = q
q = l(q)
if (q <= 0) exit
end do
end if
l(s) = p
s = t
do
t = p
p = l(p)
if (p <= 0) exit
end do
else
l(s) = sign(p,l(s))
s = p
p = l(p)
if (p>0) then
do
if (abs(k(p)) > abs(k(q))) cycle outer
s = p
p = l(p)
if (p <= 0) exit
end do
end if
! otherwise, one sublist ended, and we append to it the rest
! of the other one.
l(s) = q
s = t
do
t = q
q = l(q)
if (q <= 0) exit
end do
end if
p = -p
q = -q
if (q == 0) then
l(s) = sign(p,l(s))
l(t) = 0
exit outer
end if
end do outer
end do mergepass
end subroutine psi_i2_amsort_up
subroutine psi_i2_amsort_dw(n,k,l,iret)
use psb_const_mod
implicit none
integer(psb_ipk_) :: n, iret
integer(psb_i2pk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
!
integer(psb_ipk_) :: p,q,s,t
! ..
iret = 0
! first step: we are preparing ordered sublists, exploiting
! what order was already in the input data; negative links
! mark the end of the sublists
l(0) = 1
t = n + 1
do p = 1,n - 1
if (abs(k(p)) >= abs(k(p+1))) then
l(p) = p + 1
else
l(t) = - (p+1)
t = p
end if
end do
l(t) = 0
l(n) = 0
! see if the input was already sorted
if (l(n+1) == 0) then
iret = 1
return
else
l(n+1) = abs(l(n+1))
end if
mergepass: do
! otherwise, begin a pass through the list.
! throughout all the subroutine we have:
! p, q: pointing to the sublists being merged
! s: pointing to the most recently processed record
! t: pointing to the end of previously completed sublist
s = 0
t = n + 1
p = l(s)
q = l(t)
if (q == 0) exit mergepass
outer: do
if (abs(k(p)) < abs(k(q))) then
l(s) = sign(q,l(s))
s = q
q = l(q)
if (q > 0) then
do
if (abs(k(p)) >= abs(k(q))) cycle outer
s = q
q = l(q)
if (q <= 0) exit
end do
end if
l(s) = p
s = t
do
t = p
p = l(p)
if (p <= 0) exit
end do
else
l(s) = sign(p,l(s))
s = p
p = l(p)
if (p>0) then
do
if (abs(k(p)) < abs(k(q))) cycle outer
s = p
p = l(p)
if (p <= 0) exit
end do
end if
! otherwise, one sublist ended, and we append to it the rest
! of the other one.
l(s) = q
s = t
do
t = q
q = l(q)
if (q <= 0) exit
end do
end if
p = -p
q = -q
if (q == 0) then
l(s) = sign(p,l(s))
l(t) = 0
exit outer
end if
end do outer
end do mergepass
end subroutine psi_i2_amsort_dw
base/serial/sort/psb_i2_qsort_impl.f90
+1472
View File
File diff suppressed because it is too large Load Diff
base/tools/Makefile
+2 -1
View File
@@ -14,6 +14,7 @@ FOBJS = psb_cdall.o psb_cdals.o psb_cdalv.o psb_cd_inloc.o psb_cdins.o psb_cdprt
psb_dallc.o psb_dasb.o psb_dfree.o psb_dins.o \
psb_callc.o psb_casb.o psb_cfree.o psb_cins.o \
psb_zallc.o psb_zasb.o psb_zfree.o psb_zins.o \
psb_i2allc_a.o psb_i2asb_a.o psb_i2free_a.o psb_i2ins_a.o \
psb_mallc_a.o psb_masb_a.o psb_mfree_a.o psb_mins_a.o \
psb_eallc_a.o psb_easb_a.o psb_efree_a.o psb_eins_a.o \
psb_sallc_a.o psb_sasb_a.o psb_sfree_a.o psb_sins_a.o \
@@ -33,7 +34,7 @@ MPFOBJS = psb_icdasb.o psb_ssphalo.o psb_dsphalo.o psb_csphalo.o psb_zsphalo.o
psb_dcdbldext.o psb_zcdbldext.o psb_scdbldext.o psb_ccdbldext.o \
psb_s_remote_mat.o psb_d_remote_mat.o psb_c_remote_mat.o psb_z_remote_mat.o \
psb_s_remote_vect.o psb_d_remote_vect.o psb_c_remote_vect.o psb_z_remote_vect.o \
psb_e_remote_vect.o psb_m_remote_vect.o
psb_e_remote_vect.o psb_m_remote_vect.o psb_i2_remote_vect.o
LIBDIR=..
INCDIR=..