Fix string_c2f

gpucinterfaces
sfilippone 4 months ago
parent c586e53799
commit d7b22f0538

@ -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:

@ -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

@ -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 \

@ -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

@ -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')

@ -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))

@ -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')

@ -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))

@ -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')

@ -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))

@ -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')

@ -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))

@ -85,7 +85,7 @@ contains
end if
call stringc2f(methd,fmethd)
call psb_stringc2f(methd,fmethd)
feps = eps
fitmax = itmax
fitrace = itrace

@ -85,7 +85,7 @@ contains
end if
call stringc2f(methd,fmethd)
call psb_stringc2f(methd,fmethd)
feps = eps
fitmax = itmax
fitrace = itrace

@ -85,7 +85,7 @@ contains
end if
call stringc2f(methd,fmethd)
call psb_stringc2f(methd,fmethd)
feps = eps
fitmax = itmax
fitrace = itrace

@ -85,7 +85,7 @@ contains
end if
call stringc2f(methd,fmethd)
call psb_stringc2f(methd,fmethd)
feps = eps
fitmax = itmax
fitrace = itrace

@ -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)

@ -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)

@ -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)

@ -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)

@ -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)

@ -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)

@ -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)

@ -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)

@ -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

Loading…
Cancel
Save