From ecb61a0509c40805690cce03997acd5d36121554 Mon Sep 17 00:00:00 2001 From: Michele Martone Date: Fri, 22 Apr 2011 20:14:25 +0000 Subject: [PATCH] psblas3-trunk: fix to the rsb interface: numerical type codes for non double-types were wrong. --- opt/Makefile | 6 +++--- opt/psb_c_rsb_mat_mod.F90 | 6 +++--- opt/psb_d_rsb_mat_mod.F90 | 6 +++--- opt/psb_s_rsb_mat_mod.F90 | 6 +++--- opt/psb_z_rsb_mat_mod.F90 | 6 +++--- 5 files changed, 15 insertions(+), 15 deletions(-) diff --git a/opt/Makefile b/opt/Makefile index 5b416699..c637fa21 100644 --- a/opt/Makefile +++ b/opt/Makefile @@ -42,9 +42,9 @@ psb_z_rsb_mat_mod.o: rsb_z_mod.o psb_c_rsb_mat_mod.o: rsb_c_mod.o psb_s_rsb_mat_mod.o: rsb_s_mod.o -RSBD2Z=sed 's/rsb_d_/rsb_z_/g;s/psb_d_/psb_z_/g;s/real(psb_dpk_)/complex(psb_dpk_)/g;s/real(c_double)/complex(c_double)/g;s/complex(psb_dpk_)\(.*\)csnmi_res/real(psb_dpk_)\1csnmi_res/g' -RSBD2S=sed 's/rsb_d_/rsb_s_/g;s/psb_d_/psb_s_/g;s/real(psb_dpk_)/real(psb_spk_)/g;s/real(c_double)/real(c_float)/g;s/real(psb_dpk_)\(.*\)csnmi_res/real(psb_spk_)\1csnmi_res/g' -RSBD2C=sed 's/rsb_d_/rsb_c_/g;s/psb_d_/psb_c_/g;s/real(psb_dpk_)/complex(psb_spk_)/g;s/real(c_double)/complex(c_float)/g;s/complex(psb_spk_)\(.*\)csnmi_res/real(psb_spk_)\1csnmi_res/g' +RSBD2Z=sed 's/c_typecode=68/c_typecode=90/g;s/rsb_d_/rsb_z_/g;s/psb_d_/psb_z_/g;s/real(psb_dpk_)/complex(psb_dpk_)/g;s/real(c_double)/complex(c_double)/g;s/complex(psb_dpk_)\(.*\)csnmi_res/real(psb_dpk_)\1csnmi_res/g' +RSBD2S=sed 's/c_typecode=68/c_typecode=83/g;s/rsb_d_/rsb_s_/g;s/psb_d_/psb_s_/g;s/real(psb_dpk_)/real(psb_spk_)/g;s/real(c_double)/real(c_float)/g;s/real(psb_dpk_)\(.*\)csnmi_res/real(psb_spk_)\1csnmi_res/g' +RSBD2C=sed 's/c_typecode=68/c_typecode=67/g;s/rsb_d_/rsb_c_/g;s/psb_d_/psb_c_/g;s/real(psb_dpk_)/complex(psb_spk_)/g;s/real(c_double)/complex(c_float)/g;s/complex(psb_spk_)\(.*\)csnmi_res/real(psb_spk_)\1csnmi_res/g' psb_z_rsb_mat_mod.F90: psb_d_rsb_mat_mod.F90 Makefile $(RSBD2Z) $< > $@ diff --git a/opt/psb_c_rsb_mat_mod.F90 b/opt/psb_c_rsb_mat_mod.F90 index d93f660d..5e25fd3a 100644 --- a/opt/psb_c_rsb_mat_mod.F90 +++ b/opt/psb_c_rsb_mat_mod.F90 @@ -25,7 +25,7 @@ module psb_c_rsb_mat_mod #define PSBRSB_ERROR(MSG) #define PSBRSB_WARNING(MSG) #endif - integer, parameter :: c_d_typecode=68 ! FIXME: this is only valid for 'double' + integer, parameter :: c_typecode=67 ! this is module specific integer, parameter :: c_for_flags=1 ! : here should use RSB_FLAG_FORTRAN_INDICES_INTERFACE integer, parameter :: c_srt_flags =4 ! flags if rsb input is row major sorted .. !integer, parameter :: c_own_flags =-1 ! flags if rsb input shall not be freed by rsb @@ -573,7 +573,7 @@ subroutine psb_c_cp_rsb_from_coo(a,b,info) !write (*,*) b%val ! FIXME: and if sorted ? the process could be speeded up ! a%rsbmptr=rsb_allocate_rsb_sparse_matrix_const& - &(b%val,b%ia,b%ja,b%get_nzeros(),c_d_typecode,b%get_nrows(),b%get_ncols(),1,1,flags,info) + &(b%val,b%ia,b%ja,b%get_nzeros(),c_typecode,b%get_nrows(),b%get_ncols(),1,1,flags,info) info=d_rsb_to_psb_info(info) ! FIXME: should destroy tmp ? end subroutine psb_c_cp_rsb_from_coo @@ -605,7 +605,7 @@ subroutine psb_c_cp_rsb_from_fmt(a,b,info) type is (psb_c_csr_sparse_mat) call a%psb_c_base_sparse_mat%cp_from(b%psb_c_base_sparse_mat) a%rsbmptr=rsb_allocate_rsb_sparse_matrix_from_csr_const& - &(b%val,b%irp,b%ja,b%get_nzeros(),c_d_typecode,b%get_nrows(),b%get_ncols(),1,1,flags,info) + &(b%val,b%irp,b%ja,b%get_nzeros(),c_typecode,b%get_nrows(),b%get_ncols(),1,1,flags,info) info=d_rsb_to_psb_info(info) type is (psb_c_rsb_sparse_mat) diff --git a/opt/psb_d_rsb_mat_mod.F90 b/opt/psb_d_rsb_mat_mod.F90 index fd93ca83..86904639 100644 --- a/opt/psb_d_rsb_mat_mod.F90 +++ b/opt/psb_d_rsb_mat_mod.F90 @@ -25,7 +25,7 @@ module psb_d_rsb_mat_mod #define PSBRSB_ERROR(MSG) #define PSBRSB_WARNING(MSG) #endif - integer, parameter :: c_d_typecode=68 ! FIXME: this is only valid for 'double' + integer, parameter :: c_typecode=68 ! this is module specific integer, parameter :: c_for_flags=1 ! : here should use RSB_FLAG_FORTRAN_INDICES_INTERFACE integer, parameter :: c_srt_flags =4 ! flags if rsb input is row major sorted .. !integer, parameter :: c_own_flags =-1 ! flags if rsb input shall not be freed by rsb @@ -573,7 +573,7 @@ subroutine psb_d_cp_rsb_from_coo(a,b,info) !write (*,*) b%val ! FIXME: and if sorted ? the process could be speeded up ! a%rsbmptr=rsb_allocate_rsb_sparse_matrix_const& - &(b%val,b%ia,b%ja,b%get_nzeros(),c_d_typecode,b%get_nrows(),b%get_ncols(),1,1,flags,info) + &(b%val,b%ia,b%ja,b%get_nzeros(),c_typecode,b%get_nrows(),b%get_ncols(),1,1,flags,info) info=d_rsb_to_psb_info(info) ! FIXME: should destroy tmp ? end subroutine psb_d_cp_rsb_from_coo @@ -605,7 +605,7 @@ subroutine psb_d_cp_rsb_from_fmt(a,b,info) type is (psb_d_csr_sparse_mat) call a%psb_d_base_sparse_mat%cp_from(b%psb_d_base_sparse_mat) a%rsbmptr=rsb_allocate_rsb_sparse_matrix_from_csr_const& - &(b%val,b%irp,b%ja,b%get_nzeros(),c_d_typecode,b%get_nrows(),b%get_ncols(),1,1,flags,info) + &(b%val,b%irp,b%ja,b%get_nzeros(),c_typecode,b%get_nrows(),b%get_ncols(),1,1,flags,info) info=d_rsb_to_psb_info(info) type is (psb_d_rsb_sparse_mat) diff --git a/opt/psb_s_rsb_mat_mod.F90 b/opt/psb_s_rsb_mat_mod.F90 index ba33c735..8635273c 100644 --- a/opt/psb_s_rsb_mat_mod.F90 +++ b/opt/psb_s_rsb_mat_mod.F90 @@ -25,7 +25,7 @@ module psb_s_rsb_mat_mod #define PSBRSB_ERROR(MSG) #define PSBRSB_WARNING(MSG) #endif - integer, parameter :: c_d_typecode=68 ! FIXME: this is only valid for 'double' + integer, parameter :: c_typecode=83 ! this is module specific integer, parameter :: c_for_flags=1 ! : here should use RSB_FLAG_FORTRAN_INDICES_INTERFACE integer, parameter :: c_srt_flags =4 ! flags if rsb input is row major sorted .. !integer, parameter :: c_own_flags =-1 ! flags if rsb input shall not be freed by rsb @@ -573,7 +573,7 @@ subroutine psb_s_cp_rsb_from_coo(a,b,info) !write (*,*) b%val ! FIXME: and if sorted ? the process could be speeded up ! a%rsbmptr=rsb_allocate_rsb_sparse_matrix_const& - &(b%val,b%ia,b%ja,b%get_nzeros(),c_d_typecode,b%get_nrows(),b%get_ncols(),1,1,flags,info) + &(b%val,b%ia,b%ja,b%get_nzeros(),c_typecode,b%get_nrows(),b%get_ncols(),1,1,flags,info) info=d_rsb_to_psb_info(info) ! FIXME: should destroy tmp ? end subroutine psb_s_cp_rsb_from_coo @@ -605,7 +605,7 @@ subroutine psb_s_cp_rsb_from_fmt(a,b,info) type is (psb_s_csr_sparse_mat) call a%psb_s_base_sparse_mat%cp_from(b%psb_s_base_sparse_mat) a%rsbmptr=rsb_allocate_rsb_sparse_matrix_from_csr_const& - &(b%val,b%irp,b%ja,b%get_nzeros(),c_d_typecode,b%get_nrows(),b%get_ncols(),1,1,flags,info) + &(b%val,b%irp,b%ja,b%get_nzeros(),c_typecode,b%get_nrows(),b%get_ncols(),1,1,flags,info) info=d_rsb_to_psb_info(info) type is (psb_s_rsb_sparse_mat) diff --git a/opt/psb_z_rsb_mat_mod.F90 b/opt/psb_z_rsb_mat_mod.F90 index d7d6103f..c59e4878 100644 --- a/opt/psb_z_rsb_mat_mod.F90 +++ b/opt/psb_z_rsb_mat_mod.F90 @@ -25,7 +25,7 @@ module psb_z_rsb_mat_mod #define PSBRSB_ERROR(MSG) #define PSBRSB_WARNING(MSG) #endif - integer, parameter :: c_d_typecode=68 ! FIXME: this is only valid for 'double' + integer, parameter :: c_typecode=90 ! this is module specific integer, parameter :: c_for_flags=1 ! : here should use RSB_FLAG_FORTRAN_INDICES_INTERFACE integer, parameter :: c_srt_flags =4 ! flags if rsb input is row major sorted .. !integer, parameter :: c_own_flags =-1 ! flags if rsb input shall not be freed by rsb @@ -573,7 +573,7 @@ subroutine psb_z_cp_rsb_from_coo(a,b,info) !write (*,*) b%val ! FIXME: and if sorted ? the process could be speeded up ! a%rsbmptr=rsb_allocate_rsb_sparse_matrix_const& - &(b%val,b%ia,b%ja,b%get_nzeros(),c_d_typecode,b%get_nrows(),b%get_ncols(),1,1,flags,info) + &(b%val,b%ia,b%ja,b%get_nzeros(),c_typecode,b%get_nrows(),b%get_ncols(),1,1,flags,info) info=d_rsb_to_psb_info(info) ! FIXME: should destroy tmp ? end subroutine psb_z_cp_rsb_from_coo @@ -605,7 +605,7 @@ subroutine psb_z_cp_rsb_from_fmt(a,b,info) type is (psb_z_csr_sparse_mat) call a%psb_z_base_sparse_mat%cp_from(b%psb_z_base_sparse_mat) a%rsbmptr=rsb_allocate_rsb_sparse_matrix_from_csr_const& - &(b%val,b%irp,b%ja,b%get_nzeros(),c_d_typecode,b%get_nrows(),b%get_ncols(),1,1,flags,info) + &(b%val,b%irp,b%ja,b%get_nzeros(),c_typecode,b%get_nrows(),b%get_ncols(),1,1,flags,info) info=d_rsb_to_psb_info(info) type is (psb_z_rsb_sparse_mat)