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

Fix string_c2f

Browse Source
This commit is contained in:
sfilippone
2026-01-15 11:35:05 +01:00
parent c586e53799
commit d7b22f0538
25 changed files with 65 additions and 111 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Makefile
+1 -1
View File
@@ -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:
base/modules/auxil/psb_string_mod.f90
+34
View File
@@ -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
cbind/base/Makefile
+1 -2
View File
@@ -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 \
cbind/base/psb_base_string_cbind_mod.f90
-38
View File
@@ -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
cbind/base/psb_c_serial_cbind_mod.F90
+1 -5
View File
@@ -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')
cbind/base/psb_c_tools_cbind_mod.F90
+2 -3
View File
@@ -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))
cbind/base/psb_d_serial_cbind_mod.F90
+1 -5
View File
@@ -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')
cbind/base/psb_d_tools_cbind_mod.F90
+2 -3
View File
@@ -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))
cbind/base/psb_s_serial_cbind_mod.F90
+1 -5
View File
@@ -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')
cbind/base/psb_s_tools_cbind_mod.F90
+2 -3
View File
@@ -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))
cbind/base/psb_z_serial_cbind_mod.F90
+1 -5
View File
@@ -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')
cbind/base/psb_z_tools_cbind_mod.F90
+2 -3
View File
@@ -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))
cbind/linsolve/psb_clinsolve_cbind_mod.f90
+1 -1
View File
@@ -85,7 +85,7 @@ contains
end if
call stringc2f(methd,fmethd)
call psb_stringc2f(methd,fmethd)
feps = eps
fitmax = itmax
fitrace = itrace
cbind/linsolve/psb_dlinsolve_cbind_mod.f90
+1 -1
View File
@@ -85,7 +85,7 @@ contains
end if
call stringc2f(methd,fmethd)
call psb_stringc2f(methd,fmethd)
feps = eps
fitmax = itmax
fitrace = itrace
cbind/linsolve/psb_slinsolve_cbind_mod.f90
+1 -1
View File
@@ -85,7 +85,7 @@ contains
end if
call stringc2f(methd,fmethd)
call psb_stringc2f(methd,fmethd)
feps = eps
fitmax = itmax
fitrace = itrace
cbind/linsolve/psb_zlinsolve_cbind_mod.f90
+1 -1
View File
@@ -85,7 +85,7 @@ contains
end if
call stringc2f(methd,fmethd)
call psb_stringc2f(methd,fmethd)
feps = eps
fitmax = itmax
fitrace = itrace
cbind/prec/psb_cprec_cbind_mod.f90
+1 -1
View File
@@ -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)
cbind/prec/psb_dprec_cbind_mod.f90
+1 -1
View File
@@ -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)
cbind/prec/psb_sprec_cbind_mod.f90
+1 -1
View File
@@ -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)
cbind/prec/psb_zprec_cbind_mod.f90
+1 -1
View File
@@ -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)
cbind/util/psb_c_util_cbind_mod.f90
+2 -2
View File
@@ -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)
cbind/util/psb_d_util_cbind_mod.f90
+2 -2
View File
@@ -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)
cbind/util/psb_s_util_cbind_mod.f90
+2 -2
View File
@@ -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)
cbind/util/psb_z_util_cbind_mod.f90
+2 -2
View File
@@ -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)
cuda/psb_cuda_env_mod.F90
+1 -22
View File
@@ -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