From 78b4b0ddc5068d1398999827a3fd769abc0b8af5 Mon Sep 17 00:00:00 2001 From: cirdans-home Date: Wed, 30 Mar 2022 03:08:44 -0400 Subject: [PATCH] Added utility to dump global matrix --- cbind/util/psb_c_cutil.h | 1 + cbind/util/psb_c_dutil.h | 1 + cbind/util/psb_c_sutil.h | 1 + cbind/util/psb_c_util_cbind_mod.f90 | 44 +++++++++++++++++++++++++++++ cbind/util/psb_c_zutil.h | 1 + cbind/util/psb_d_util_cbind_mod.f90 | 44 +++++++++++++++++++++++++++++ cbind/util/psb_s_util_cbind_mod.f90 | 44 +++++++++++++++++++++++++++++ cbind/util/psb_z_util_cbind_mod.f90 | 44 +++++++++++++++++++++++++++++ 8 files changed, 180 insertions(+) diff --git a/cbind/util/psb_c_cutil.h b/cbind/util/psb_c_cutil.h index 4d2755d6..c9ca4211 100644 --- a/cbind/util/psb_c_cutil.h +++ b/cbind/util/psb_c_cutil.h @@ -8,6 +8,7 @@ extern "C" { /* I/O Routine */ psb_i_t psb_c_cmm_mat_write(psb_c_cspmat *ah, char *matrixtitle, char *filename); +psb_i_t psb_c_cglobal_mat_write(psb_c_cspmat *ah,psb_c_descriptor *cdh); #ifdef __cplusplus } diff --git a/cbind/util/psb_c_dutil.h b/cbind/util/psb_c_dutil.h index 306d7310..2931e530 100644 --- a/cbind/util/psb_c_dutil.h +++ b/cbind/util/psb_c_dutil.h @@ -8,6 +8,7 @@ extern "C" { /* I/O Routine */ psb_i_t psb_c_dmm_mat_write(psb_c_dspmat *ah, char *matrixtitle, char *filename); +psb_i_t psb_c_dglobal_mat_write(psb_c_dspmat *ah,psb_c_descriptor *cdh); #ifdef __cplusplus } diff --git a/cbind/util/psb_c_sutil.h b/cbind/util/psb_c_sutil.h index 9dd1ed54..3fd9f0ca 100644 --- a/cbind/util/psb_c_sutil.h +++ b/cbind/util/psb_c_sutil.h @@ -8,6 +8,7 @@ extern "C" { /* I/O Routine */ psb_i_t psb_c_smm_mat_write(psb_c_sspmat *ah, char *matrixtitle, char *filename); +psb_i_t psb_c_sglobal_mat_write(psb_c_sspmat *ah,psb_c_descriptor *cdh); #ifdef __cplusplus } diff --git a/cbind/util/psb_c_util_cbind_mod.f90 b/cbind/util/psb_c_util_cbind_mod.f90 index 3761cd08..cd322b56 100644 --- a/cbind/util/psb_c_util_cbind_mod.f90 +++ b/cbind/util/psb_c_util_cbind_mod.f90 @@ -41,4 +41,48 @@ contains end function psb_c_cmm_mat_write + function psb_c_cglobal_mat_write(ah,cdh) bind(c) result(res) + use psb_base_mod + use psb_util_mod + use psb_base_string_cbind_mod + implicit none + integer(psb_c_ipk_) :: res + + type(psb_c_cspmat) :: ah + type(psb_c_descriptor) :: cdh + + type(psb_cspmat_type), pointer :: ap + type(psb_desc_type), pointer :: descp + ! Local variables + type(psb_cspmat_type) :: aglobal + integer(psb_ipk_) :: info, iam, np + type(psb_ctxt_type) :: ctxt + character(len=40) :: matrixname + + res = -1 + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(ah%item)) then + call c_f_pointer(ah%item,ap) + else + return + end if + + ctxt = descp%get_ctxt() + call psb_info(ctxt,iam,np) + call psb_gather(aglobal,ap,descp,info) + if (iam == psb_root_) then + write(matrixname,'("A-np-",I1,".mtx")') np + call mm_mat_write(aglobal,"Global matrix",info,filename=trim(matrixname)) + end if + + call psb_spfree(aglobal,descp,info) + res = info + + end function psb_c_cglobal_mat_write + + end module psb_cutil_cbind_mod diff --git a/cbind/util/psb_c_zutil.h b/cbind/util/psb_c_zutil.h index f5d0f225..b1b47e35 100644 --- a/cbind/util/psb_c_zutil.h +++ b/cbind/util/psb_c_zutil.h @@ -8,6 +8,7 @@ extern "C" { /* I/O Routine */ psb_i_t psb_c_zmm_mat_write(psb_c_zspmat *ah, char *matrixtitle, char *filename); +psb_i_t psb_c_zglobal_mat_write(psb_c_zspmat *ah,psb_c_descriptor *cdh); #ifdef __cplusplus } diff --git a/cbind/util/psb_d_util_cbind_mod.f90 b/cbind/util/psb_d_util_cbind_mod.f90 index 245cff5e..60e282a3 100644 --- a/cbind/util/psb_d_util_cbind_mod.f90 +++ b/cbind/util/psb_d_util_cbind_mod.f90 @@ -41,4 +41,48 @@ contains end function psb_c_dmm_mat_write + function psb_c_dglobal_mat_write(ah,cdh) bind(c) result(res) + use psb_base_mod + use psb_util_mod + use psb_base_string_cbind_mod + implicit none + integer(psb_c_ipk_) :: res + + type(psb_c_dspmat) :: ah + type(psb_c_descriptor) :: cdh + + type(psb_dspmat_type), pointer :: ap + type(psb_desc_type), pointer :: descp + ! Local variables + type(psb_dspmat_type) :: aglobal + integer(psb_ipk_) :: info, iam, np + type(psb_ctxt_type) :: ctxt + character(len=40) :: matrixname + + res = -1 + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(ah%item)) then + call c_f_pointer(ah%item,ap) + else + return + end if + + ctxt = descp%get_ctxt() + call psb_info(ctxt,iam,np) + call psb_gather(aglobal,ap,descp,info) + if (iam == psb_root_) then + write(matrixname,'("A-np-",I1,".mtx")') np + call mm_mat_write(aglobal,"Global matrix",info,filename=trim(matrixname)) + end if + + call psb_spfree(aglobal,descp,info) + res = info + + end function psb_c_dglobal_mat_write + + end module psb_dutil_cbind_mod diff --git a/cbind/util/psb_s_util_cbind_mod.f90 b/cbind/util/psb_s_util_cbind_mod.f90 index e857cde9..947f88d9 100644 --- a/cbind/util/psb_s_util_cbind_mod.f90 +++ b/cbind/util/psb_s_util_cbind_mod.f90 @@ -41,4 +41,48 @@ contains end function psb_c_smm_mat_write + function psb_c_sglobal_mat_write(ah,cdh) bind(c) result(res) + use psb_base_mod + use psb_util_mod + use psb_base_string_cbind_mod + implicit none + integer(psb_c_ipk_) :: res + + type(psb_c_sspmat) :: ah + type(psb_c_descriptor) :: cdh + + type(psb_sspmat_type), pointer :: ap + type(psb_desc_type), pointer :: descp + ! Local variables + type(psb_sspmat_type) :: aglobal + integer(psb_ipk_) :: info, iam, np + type(psb_ctxt_type) :: ctxt + character(len=40) :: matrixname + + res = -1 + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(ah%item)) then + call c_f_pointer(ah%item,ap) + else + return + end if + + ctxt = descp%get_ctxt() + call psb_info(ctxt,iam,np) + call psb_gather(aglobal,ap,descp,info) + if (iam == psb_root_) then + write(matrixname,'("A-np-",I1,".mtx")') np + call mm_mat_write(aglobal,"Global matrix",info,filename=trim(matrixname)) + end if + + call psb_spfree(aglobal,descp,info) + res = info + + end function psb_c_sglobal_mat_write + + end module psb_sutil_cbind_mod diff --git a/cbind/util/psb_z_util_cbind_mod.f90 b/cbind/util/psb_z_util_cbind_mod.f90 index e0b60005..46412550 100644 --- a/cbind/util/psb_z_util_cbind_mod.f90 +++ b/cbind/util/psb_z_util_cbind_mod.f90 @@ -41,4 +41,48 @@ contains end function psb_c_zmm_mat_write + function psb_c_zglobal_mat_write(ah,cdh) bind(c) result(res) + use psb_base_mod + use psb_util_mod + use psb_base_string_cbind_mod + implicit none + integer(psb_c_ipk_) :: res + + type(psb_c_zspmat) :: ah + type(psb_c_descriptor) :: cdh + + type(psb_zspmat_type), pointer :: ap + type(psb_desc_type), pointer :: descp + ! Local variables + type(psb_zspmat_type) :: aglobal + integer(psb_ipk_) :: info, iam, np + type(psb_ctxt_type) :: ctxt + character(len=40) :: matrixname + + res = -1 + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(ah%item)) then + call c_f_pointer(ah%item,ap) + else + return + end if + + ctxt = descp%get_ctxt() + call psb_info(ctxt,iam,np) + call psb_gather(aglobal,ap,descp,info) + if (iam == psb_root_) then + write(matrixname,'("A-np-",I1,".mtx")') np + call mm_mat_write(aglobal,"Global matrix",info,filename=trim(matrixname)) + end if + + call psb_spfree(aglobal,descp,info) + res = info + + end function psb_c_zglobal_mat_write + + end module psb_zutil_cbind_mod