From d7b22f0538164780c2f8ef430c9bfdb9332d8309 Mon Sep 17 00:00:00 2001 From: sfilippone Date: Thu, 15 Jan 2026 11:35:05 +0100 Subject: [PATCH] Fix string_c2f --- Makefile | 2 +- base/modules/auxil/psb_string_mod.f90 | 34 +++++++++++++++++++ cbind/base/Makefile | 3 +- cbind/base/psb_base_string_cbind_mod.f90 | 38 ---------------------- cbind/base/psb_c_serial_cbind_mod.F90 | 6 +--- cbind/base/psb_c_tools_cbind_mod.F90 | 5 ++- cbind/base/psb_d_serial_cbind_mod.F90 | 6 +--- cbind/base/psb_d_tools_cbind_mod.F90 | 5 ++- cbind/base/psb_s_serial_cbind_mod.F90 | 6 +--- cbind/base/psb_s_tools_cbind_mod.F90 | 5 ++- cbind/base/psb_z_serial_cbind_mod.F90 | 6 +--- cbind/base/psb_z_tools_cbind_mod.F90 | 5 ++- cbind/linsolve/psb_clinsolve_cbind_mod.f90 | 2 +- cbind/linsolve/psb_dlinsolve_cbind_mod.f90 | 2 +- cbind/linsolve/psb_slinsolve_cbind_mod.f90 | 2 +- cbind/linsolve/psb_zlinsolve_cbind_mod.f90 | 2 +- cbind/prec/psb_cprec_cbind_mod.f90 | 2 +- cbind/prec/psb_dprec_cbind_mod.f90 | 2 +- cbind/prec/psb_sprec_cbind_mod.f90 | 2 +- cbind/prec/psb_zprec_cbind_mod.f90 | 2 +- cbind/util/psb_c_util_cbind_mod.f90 | 4 +-- cbind/util/psb_d_util_cbind_mod.f90 | 4 +-- cbind/util/psb_s_util_cbind_mod.f90 | 4 +-- cbind/util/psb_z_util_cbind_mod.f90 | 4 +-- cuda/psb_cuda_env_mod.F90 | 23 +------------ 25 files changed, 65 insertions(+), 111 deletions(-) delete mode 100644 cbind/base/psb_base_string_cbind_mod.f90 diff --git a/Makefile b/Makefile index d210accb..9a302655 100644 --- a/Makefile +++ b/Makefile @@ -12,7 +12,7 @@ dirs: mods: basemods precmods linslvmods utilmods cbindmods extmods $(CUDAMODS) $(OACCMODS) precmods utilmods extmods: basemods linslvmods: precmods -cbindmods: basemods precmods linslvmods utilmods +cbindmods: basemods precmods linslvmods utilmods $(CUDAMODS) oaccmods: extmods cudamods: extmods basemods: diff --git a/base/modules/auxil/psb_string_mod.f90 b/base/modules/auxil/psb_string_mod.f90 index a9457639..254d5e6b 100644 --- a/base/modules/auxil/psb_string_mod.f90 +++ b/base/modules/auxil/psb_string_mod.f90 @@ -31,7 +31,11 @@ ! module psb_string_mod use psb_const_mod, only : psb_ipk_ + use iso_c_binding + public psb_tolower, psb_toupper, psb_touppers + public psb_stringf2c, psb_stringc2f + interface psb_tolower module procedure psb_tolowerc end interface @@ -127,6 +131,36 @@ contains end subroutine psb_sub_toupperc + subroutine psb_stringc2f(cstring,fstring) + character(c_char) :: cstring(*) + character(len=*) :: fstring + integer :: i + + i = 1 + do + if (cstring(i) == c_null_char) exit + if (i > len(fstring)) exit + fstring(i:i) = cstring(i) + i = i + 1 + end do + do + if (i > len(fstring)) exit + fstring(i:i) = " " + i = i + 1 + end do + return + end subroutine psb_stringc2f + subroutine psb_stringf2c(fstring,cstring) + character(c_char) :: cstring(*) + character(len=*) :: fstring + integer :: i + + do i=1, len(fstring) + cstring(i) = fstring(i:i) + end do + cstring(len(fstring)+1) = c_null_char + return + end subroutine psb_stringf2c end module psb_string_mod diff --git a/cbind/base/Makefile b/cbind/base/Makefile index 3ddc2eb2..ce0493d2 100644 --- a/cbind/base/Makefile +++ b/cbind/base/Makefile @@ -9,8 +9,7 @@ FINCLUDES=$(FMFLAG). $(FMFLAG)$(HERE) $(FMFLAG)$(MODDIR) CINCLUDES=-I. -I$(HERE) -I$(INCLUDEDIR) FOBJS= psb_objhandle_mod.o psb_base_cbind_mod.o psb_cpenv_mod.o \ - psb_base_tools_cbind_mod.o psb_base_string_cbind_mod.o \ - psb_base_psblas_cbind_mod.o \ + psb_base_tools_cbind_mod.o psb_base_psblas_cbind_mod.o \ psb_s_tools_cbind_mod.o psb_s_serial_cbind_mod.o psb_s_psblas_cbind_mod.o \ psb_d_tools_cbind_mod.o psb_d_serial_cbind_mod.o psb_d_psblas_cbind_mod.o \ psb_c_tools_cbind_mod.o psb_c_serial_cbind_mod.o psb_c_psblas_cbind_mod.o \ diff --git a/cbind/base/psb_base_string_cbind_mod.f90 b/cbind/base/psb_base_string_cbind_mod.f90 deleted file mode 100644 index 05cd9d7d..00000000 --- a/cbind/base/psb_base_string_cbind_mod.f90 +++ /dev/null @@ -1,38 +0,0 @@ -module psb_base_string_cbind_mod - use iso_c_binding - -contains - - subroutine stringc2f(cstring,fstring) - character(c_char) :: cstring(*) - character(len=*) :: fstring - integer :: i - - i = 1 - do - if (cstring(i) == c_null_char) exit - if (i > len(fstring)) exit - fstring(i:i) = cstring(i) - i = i + 1 - end do - do - if (i > len(fstring)) exit - fstring(i:i) = " " - i = i + 1 - end do - return - end subroutine stringc2f - - subroutine stringf2c(fstring,cstring) - character(c_char) :: cstring(*) - character(len=*) :: fstring - integer :: i - - do i=1, len(fstring) - cstring(i) = fstring(i:i) - end do - cstring(len(fstring)+1) = c_null_char - return - end subroutine stringf2c - -end module psb_base_string_cbind_mod diff --git a/cbind/base/psb_c_serial_cbind_mod.F90 b/cbind/base/psb_c_serial_cbind_mod.F90 index 04e21d33..805f4965 100644 --- a/cbind/base/psb_c_serial_cbind_mod.F90 +++ b/cbind/base/psb_c_serial_cbind_mod.F90 @@ -2,7 +2,6 @@ module psb_c_serial_cbind_mod use iso_c_binding use psb_base_mod use psb_objhandle_mod -! use psb_base_string_cbind_mod use psb_base_tools_cbind_mod contains @@ -89,7 +88,6 @@ contains function psb_c_cmat_get_nrows(mh) bind(c) result(res) use psb_base_mod use psb_objhandle_mod - use psb_base_string_cbind_mod implicit none integer(psb_c_ipk_) :: res @@ -112,7 +110,6 @@ contains function psb_c_cmat_get_ncols(mh) bind(c) result(res) use psb_base_mod use psb_objhandle_mod - use psb_base_string_cbind_mod implicit none integer(psb_c_ipk_) :: res @@ -135,7 +132,6 @@ contains function psb_c_cmat_name_print(mh,name) bind(c) result(res) use psb_base_mod use psb_objhandle_mod - use psb_base_string_cbind_mod implicit none integer(psb_c_ipk_) :: res @@ -151,7 +147,7 @@ contains else return end if - call stringc2f(name,fname) + call psb_stringc2f(name,fname) call ap%print(fname,head='PSBLAS Cbinding Interface') diff --git a/cbind/base/psb_c_tools_cbind_mod.F90 b/cbind/base/psb_c_tools_cbind_mod.F90 index b8aedc49..33e259e6 100644 --- a/cbind/base/psb_c_tools_cbind_mod.F90 +++ b/cbind/base/psb_c_tools_cbind_mod.F90 @@ -166,7 +166,6 @@ contains function psb_c_cgeasb_options_format(xh,cdh,dupl,format) bind(c) result(res) ! Takes into account format argument as a c string, and uses it to call the appropriate psb_geasb ! with mold argument - use psb_base_string_cbind_mod, only: stringc2f implicit none integer(psb_c_ipk_) :: res type(psb_c_cvector) :: xh @@ -187,7 +186,7 @@ contains class(psb_c_base_vect_type), pointer :: vmold ! Select mold based on format - call stringc2f(format,fformat) + call psb_stringc2f(format,fformat) select case (psb_toupper(fformat)) #ifdef PSB_HAVE_CUDA @@ -466,7 +465,7 @@ contains else return end if - call stringc2f(afmt,fafmt) + call psb_stringc2f(afmt,fafmt) ! Set the mold variable based on afmt select case (psb_toupper(fafmt)) diff --git a/cbind/base/psb_d_serial_cbind_mod.F90 b/cbind/base/psb_d_serial_cbind_mod.F90 index 0e71e9ee..04d840bd 100644 --- a/cbind/base/psb_d_serial_cbind_mod.F90 +++ b/cbind/base/psb_d_serial_cbind_mod.F90 @@ -2,7 +2,6 @@ module psb_d_serial_cbind_mod use iso_c_binding use psb_base_mod use psb_objhandle_mod -! use psb_base_string_cbind_mod use psb_base_tools_cbind_mod contains @@ -89,7 +88,6 @@ contains function psb_c_dmat_get_nrows(mh) bind(c) result(res) use psb_base_mod use psb_objhandle_mod - use psb_base_string_cbind_mod implicit none integer(psb_c_ipk_) :: res @@ -112,7 +110,6 @@ contains function psb_c_dmat_get_ncols(mh) bind(c) result(res) use psb_base_mod use psb_objhandle_mod - use psb_base_string_cbind_mod implicit none integer(psb_c_ipk_) :: res @@ -135,7 +132,6 @@ contains function psb_c_dmat_name_print(mh,name) bind(c) result(res) use psb_base_mod use psb_objhandle_mod - use psb_base_string_cbind_mod implicit none integer(psb_c_ipk_) :: res @@ -151,7 +147,7 @@ contains else return end if - call stringc2f(name,fname) + call psb_stringc2f(name,fname) call ap%print(fname,head='PSBLAS Cbinding Interface') diff --git a/cbind/base/psb_d_tools_cbind_mod.F90 b/cbind/base/psb_d_tools_cbind_mod.F90 index c70d018a..95ed9e9e 100644 --- a/cbind/base/psb_d_tools_cbind_mod.F90 +++ b/cbind/base/psb_d_tools_cbind_mod.F90 @@ -166,7 +166,6 @@ contains function psb_c_dgeasb_options_format(xh,cdh,dupl,format) bind(c) result(res) ! Takes into account format argument as a c string, and uses it to call the appropriate psb_geasb ! with mold argument - use psb_base_string_cbind_mod, only: stringc2f implicit none integer(psb_c_ipk_) :: res type(psb_c_dvector) :: xh @@ -187,7 +186,7 @@ contains class(psb_d_base_vect_type), pointer :: vmold ! Select mold based on format - call stringc2f(format,fformat) + call psb_stringc2f(format,fformat) select case (psb_toupper(fformat)) #ifdef PSB_HAVE_CUDA @@ -467,7 +466,7 @@ contains else return end if - call stringc2f(afmt,fafmt) + call psb_stringc2f(afmt,fafmt) ! Set the mold variable based on afmt select case (psb_toupper(fafmt)) diff --git a/cbind/base/psb_s_serial_cbind_mod.F90 b/cbind/base/psb_s_serial_cbind_mod.F90 index 2610e883..e9f65bab 100644 --- a/cbind/base/psb_s_serial_cbind_mod.F90 +++ b/cbind/base/psb_s_serial_cbind_mod.F90 @@ -2,7 +2,6 @@ module psb_s_serial_cbind_mod use iso_c_binding use psb_base_mod use psb_objhandle_mod -! use psb_base_string_cbind_mod use psb_base_tools_cbind_mod contains @@ -89,7 +88,6 @@ contains function psb_c_smat_get_nrows(mh) bind(c) result(res) use psb_base_mod use psb_objhandle_mod - use psb_base_string_cbind_mod implicit none integer(psb_c_ipk_) :: res @@ -112,7 +110,6 @@ contains function psb_c_smat_get_ncols(mh) bind(c) result(res) use psb_base_mod use psb_objhandle_mod - use psb_base_string_cbind_mod implicit none integer(psb_c_ipk_) :: res @@ -135,7 +132,6 @@ contains function psb_c_smat_name_print(mh,name) bind(c) result(res) use psb_base_mod use psb_objhandle_mod - use psb_base_string_cbind_mod implicit none integer(psb_c_ipk_) :: res @@ -151,7 +147,7 @@ contains else return end if - call stringc2f(name,fname) + call psb_stringc2f(name,fname) call ap%print(fname,head='PSBLAS Cbinding Interface') diff --git a/cbind/base/psb_s_tools_cbind_mod.F90 b/cbind/base/psb_s_tools_cbind_mod.F90 index e93bb35f..0ad7e60d 100644 --- a/cbind/base/psb_s_tools_cbind_mod.F90 +++ b/cbind/base/psb_s_tools_cbind_mod.F90 @@ -166,7 +166,6 @@ contains function psb_c_sgeasb_options_format(xh,cdh,dupl,format) bind(c) result(res) ! Takes into account format argument as a c string, and uses it to call the appropriate psb_geasb ! with mold argument - use psb_base_string_cbind_mod, only: stringc2f implicit none integer(psb_c_ipk_) :: res type(psb_c_svector) :: xh @@ -187,7 +186,7 @@ contains class(psb_s_base_vect_type), pointer :: vmold ! Select mold based on format - call stringc2f(format,fformat) + call psb_stringc2f(format,fformat) select case (psb_toupper(fformat)) #ifdef PSB_HAVE_CUDA @@ -467,7 +466,7 @@ contains else return end if - call stringc2f(afmt,fafmt) + call psb_stringc2f(afmt,fafmt) ! Set the mold variable based on afmt select case (psb_toupper(fafmt)) diff --git a/cbind/base/psb_z_serial_cbind_mod.F90 b/cbind/base/psb_z_serial_cbind_mod.F90 index aad86746..fa3d7e12 100644 --- a/cbind/base/psb_z_serial_cbind_mod.F90 +++ b/cbind/base/psb_z_serial_cbind_mod.F90 @@ -2,7 +2,6 @@ module psb_z_serial_cbind_mod use iso_c_binding use psb_base_mod use psb_objhandle_mod -! use psb_base_string_cbind_mod use psb_base_tools_cbind_mod contains @@ -89,7 +88,6 @@ contains function psb_c_zmat_get_nrows(mh) bind(c) result(res) use psb_base_mod use psb_objhandle_mod - use psb_base_string_cbind_mod implicit none integer(psb_c_ipk_) :: res @@ -112,7 +110,6 @@ contains function psb_c_zmat_get_ncols(mh) bind(c) result(res) use psb_base_mod use psb_objhandle_mod - use psb_base_string_cbind_mod implicit none integer(psb_c_ipk_) :: res @@ -135,7 +132,6 @@ contains function psb_c_zmat_name_print(mh,name) bind(c) result(res) use psb_base_mod use psb_objhandle_mod - use psb_base_string_cbind_mod implicit none integer(psb_c_ipk_) :: res @@ -151,7 +147,7 @@ contains else return end if - call stringc2f(name,fname) + call psb_stringc2f(name,fname) call ap%print(fname,head='PSBLAS Cbinding Interface') diff --git a/cbind/base/psb_z_tools_cbind_mod.F90 b/cbind/base/psb_z_tools_cbind_mod.F90 index 47aae520..6c530889 100644 --- a/cbind/base/psb_z_tools_cbind_mod.F90 +++ b/cbind/base/psb_z_tools_cbind_mod.F90 @@ -166,7 +166,6 @@ contains function psb_c_zgeasb_options_format(xh,cdh,dupl,format) bind(c) result(res) ! Takes into account format argument as a c string, and uses it to call the appropriate psb_geasb ! with mold argument - use psb_base_string_cbind_mod, only: stringc2f implicit none integer(psb_c_ipk_) :: res type(psb_c_zvector) :: xh @@ -187,7 +186,7 @@ contains class(psb_z_base_vect_type), pointer :: vmold ! Select mold based on format - call stringc2f(format,fformat) + call psb_stringc2f(format,fformat) select case (psb_toupper(fformat)) #ifdef PSB_HAVE_CUDA @@ -466,7 +465,7 @@ contains else return end if - call stringc2f(afmt,fafmt) + call psb_stringc2f(afmt,fafmt) ! Set the mold variable based on afmt select case (psb_toupper(fafmt)) diff --git a/cbind/linsolve/psb_clinsolve_cbind_mod.f90 b/cbind/linsolve/psb_clinsolve_cbind_mod.f90 index 29a0b2fc..da75fa3c 100644 --- a/cbind/linsolve/psb_clinsolve_cbind_mod.f90 +++ b/cbind/linsolve/psb_clinsolve_cbind_mod.f90 @@ -85,7 +85,7 @@ contains end if - call stringc2f(methd,fmethd) + call psb_stringc2f(methd,fmethd) feps = eps fitmax = itmax fitrace = itrace diff --git a/cbind/linsolve/psb_dlinsolve_cbind_mod.f90 b/cbind/linsolve/psb_dlinsolve_cbind_mod.f90 index 35612ec3..542a97e1 100644 --- a/cbind/linsolve/psb_dlinsolve_cbind_mod.f90 +++ b/cbind/linsolve/psb_dlinsolve_cbind_mod.f90 @@ -85,7 +85,7 @@ contains end if - call stringc2f(methd,fmethd) + call psb_stringc2f(methd,fmethd) feps = eps fitmax = itmax fitrace = itrace diff --git a/cbind/linsolve/psb_slinsolve_cbind_mod.f90 b/cbind/linsolve/psb_slinsolve_cbind_mod.f90 index e1823bd8..2efa3afe 100644 --- a/cbind/linsolve/psb_slinsolve_cbind_mod.f90 +++ b/cbind/linsolve/psb_slinsolve_cbind_mod.f90 @@ -85,7 +85,7 @@ contains end if - call stringc2f(methd,fmethd) + call psb_stringc2f(methd,fmethd) feps = eps fitmax = itmax fitrace = itrace diff --git a/cbind/linsolve/psb_zlinsolve_cbind_mod.f90 b/cbind/linsolve/psb_zlinsolve_cbind_mod.f90 index 3234c72c..fbf1be45 100644 --- a/cbind/linsolve/psb_zlinsolve_cbind_mod.f90 +++ b/cbind/linsolve/psb_zlinsolve_cbind_mod.f90 @@ -85,7 +85,7 @@ contains end if - call stringc2f(methd,fmethd) + call psb_stringc2f(methd,fmethd) feps = eps fitmax = itmax fitrace = itrace diff --git a/cbind/prec/psb_cprec_cbind_mod.f90 b/cbind/prec/psb_cprec_cbind_mod.f90 index 6d4de220..c7f1ec6f 100644 --- a/cbind/prec/psb_cprec_cbind_mod.f90 +++ b/cbind/prec/psb_cprec_cbind_mod.f90 @@ -39,7 +39,7 @@ contains if (info /= 0) return ph%item = c_loc(precp) - call stringc2f(ptype,fptype) + call psb_stringc2f(ptype,fptype) call psb_precinit(ctxt,precp,fptype,info) diff --git a/cbind/prec/psb_dprec_cbind_mod.f90 b/cbind/prec/psb_dprec_cbind_mod.f90 index edbc427d..5e598a17 100644 --- a/cbind/prec/psb_dprec_cbind_mod.f90 +++ b/cbind/prec/psb_dprec_cbind_mod.f90 @@ -39,7 +39,7 @@ contains if (info /= 0) return ph%item = c_loc(precp) - call stringc2f(ptype,fptype) + call psb_stringc2f(ptype,fptype) call psb_precinit(ctxt,precp,fptype,info) diff --git a/cbind/prec/psb_sprec_cbind_mod.f90 b/cbind/prec/psb_sprec_cbind_mod.f90 index e450d7d8..6bdade31 100644 --- a/cbind/prec/psb_sprec_cbind_mod.f90 +++ b/cbind/prec/psb_sprec_cbind_mod.f90 @@ -39,7 +39,7 @@ contains if (info /= 0) return ph%item = c_loc(precp) - call stringc2f(ptype,fptype) + call psb_stringc2f(ptype,fptype) call psb_precinit(ctxt,precp,fptype,info) diff --git a/cbind/prec/psb_zprec_cbind_mod.f90 b/cbind/prec/psb_zprec_cbind_mod.f90 index 64b7cddb..86b66ead 100644 --- a/cbind/prec/psb_zprec_cbind_mod.f90 +++ b/cbind/prec/psb_zprec_cbind_mod.f90 @@ -39,7 +39,7 @@ contains if (info /= 0) return ph%item = c_loc(precp) - call stringc2f(ptype,fptype) + call psb_stringc2f(ptype,fptype) call psb_precinit(ctxt,precp,fptype,info) diff --git a/cbind/util/psb_c_util_cbind_mod.f90 b/cbind/util/psb_c_util_cbind_mod.f90 index ae3f6cf8..1f8fc5be 100644 --- a/cbind/util/psb_c_util_cbind_mod.f90 +++ b/cbind/util/psb_c_util_cbind_mod.f90 @@ -32,8 +32,8 @@ contains return end if - call stringc2f(matrixtitle,mtitle) - call stringc2f(filename,fname) + call psb_stringc2f(matrixtitle,mtitle) + call psb_stringc2f(filename,fname) call mm_mat_write(ap,mtitle,info,filename=fname) diff --git a/cbind/util/psb_d_util_cbind_mod.f90 b/cbind/util/psb_d_util_cbind_mod.f90 index 29fec75b..45eb8714 100644 --- a/cbind/util/psb_d_util_cbind_mod.f90 +++ b/cbind/util/psb_d_util_cbind_mod.f90 @@ -32,8 +32,8 @@ contains return end if - call stringc2f(matrixtitle,mtitle) - call stringc2f(filename,fname) + call psb_stringc2f(matrixtitle,mtitle) + call psb_stringc2f(filename,fname) call mm_mat_write(ap,mtitle,info,filename=fname) diff --git a/cbind/util/psb_s_util_cbind_mod.f90 b/cbind/util/psb_s_util_cbind_mod.f90 index 0dfe3ddc..ab1fcabe 100644 --- a/cbind/util/psb_s_util_cbind_mod.f90 +++ b/cbind/util/psb_s_util_cbind_mod.f90 @@ -32,8 +32,8 @@ contains return end if - call stringc2f(matrixtitle,mtitle) - call stringc2f(filename,fname) + call psb_stringc2f(matrixtitle,mtitle) + call psb_stringc2f(filename,fname) call mm_mat_write(ap,mtitle,info,filename=fname) diff --git a/cbind/util/psb_z_util_cbind_mod.f90 b/cbind/util/psb_z_util_cbind_mod.f90 index 792f836f..2f60e928 100644 --- a/cbind/util/psb_z_util_cbind_mod.f90 +++ b/cbind/util/psb_z_util_cbind_mod.f90 @@ -32,8 +32,8 @@ contains return end if - call stringc2f(matrixtitle,mtitle) - call stringc2f(filename,fname) + call psb_stringc2f(matrixtitle,mtitle) + call psb_stringc2f(filename,fname) call mm_mat_write(ap,mtitle,info,filename=fname) diff --git a/cuda/psb_cuda_env_mod.F90 b/cuda/psb_cuda_env_mod.F90 index 58250dbc..21078461 100644 --- a/cuda/psb_cuda_env_mod.F90 +++ b/cuda/psb_cuda_env_mod.F90 @@ -323,28 +323,7 @@ Contains character(len=256) :: res character :: cstring(256) call psb_C_cpy_NameString(cstring) - call stringc2f(cstring,res) + call psb_stringc2f(cstring,res) end function psb_cuda_DeviceName - - subroutine stringc2f(cstring,fstring) - character(c_char) :: cstring(*) - character(len=*) :: fstring - integer :: i - - i = 1 - do - if (cstring(i) == c_null_char) exit - if (i > len(fstring)) exit - fstring(i:i) = cstring(i) - i = i + 1 - end do - do - if (i > len(fstring)) exit - fstring(i:i) = " " - i = i + 1 - end do - return - end subroutine stringc2f - end module psb_cuda_env_mod