33use,
INTRINSIC :: iso_c_binding
34#ifdef WITH_VARYING_STRING
72 TYPE(c_ptr),
POINTER :: elem(:) => null()
73 CHARACTER(len=1),
POINTER :: buffer(:) => null()
80 MODULE PROCEDURE strlen_char, strlen_chararr, strlen_intarr, &
82#ifdef WITH_VARYING_STRING
83 MODULE PROCEDURE strlen_var_str
110 MODULE PROCEDURE strtofchar_char, strtofchar_chararr, strtofchar_intarr, &
121 MODULE PROCEDURE c_ptr_ptr_new_from_c, c_ptr_ptr_new_from_fchar
124INTERFACE ASSIGNMENT(=)
125 MODULE PROCEDURE strtofchararr_assign
126END INTERFACE ASSIGNMENT(=)
135PURE FUNCTION strlen_char(string)
RESULT(strlen)
139CHARACTER(kind=c_char,len=*),
INTENT(in) :: string
145 IF (string(i:i) == char(0))
EXIT
149END FUNCTION strlen_char
152PURE FUNCTION strlen_chararr(string)
RESULT(strlen)
156CHARACTER(kind=c_char,len=1),
INTENT(in) :: string(:)
161DO i = 1,
SIZE(string)
162 IF (string(i) == char(0))
EXIT
166END FUNCTION strlen_chararr
169PURE FUNCTION strlen_intarr(string)
RESULT(strlen)
173INTEGER(kind=c_signed_char),
INTENT(in) :: string(:)
178DO i = 1,
SIZE(string)
179 IF (string(i) == 0)
EXIT
183END FUNCTION strlen_intarr
186FUNCTION strlen_ptr(string)
RESULT(strlen)
190TYPE(c_ptr),
INTENT(in) :: string
193INTEGER(kind=c_signed_char),
POINTER :: pstring(:)
196IF (c_associated(string))
THEN
198 CALL c_f_pointer(string, pstring, (/huge(i)/))
200 DO i = 1,
SIZE(pstring)
201 IF (pstring(i) == 0)
EXIT
208END FUNCTION strlen_ptr
211#ifdef WITH_VARYING_STRING
212PURE FUNCTION strlen_var_str(string)
RESULT(strlen)
216TYPE(varying_string),
INTENT(in) :: string
221END FUNCTION strlen_var_str
225FUNCTION strtofchar_char(string)
RESULT(fchar)
229CHARACTER(kind=c_char,len=*),
INTENT(in) :: string
230CHARACTER(len=strlen(string)) :: fchar
232fchar(:) = string(1:len(fchar))
234END FUNCTION strtofchar_char
237FUNCTION strtofchar_chararr(string)
RESULT(fchar)
241CHARACTER(kind=c_char,len=1),
INTENT(in) :: string(:)
242CHARACTER(len=strlen(string)) :: fchar
247 fchar(i:i) = string(i)
250END FUNCTION strtofchar_chararr
253FUNCTION strtofchar_intarr(string)
RESULT(fchar)
257INTEGER(kind=c_signed_char),
INTENT(in) :: string(:)
258CHARACTER(len=strlen(string)) :: fchar
260fchar(:) = transfer(string(1:len(fchar)), fchar)
262END FUNCTION strtofchar_intarr
286FUNCTION strtofchar_ptr_2(string, fixlen)
RESULT(fchar)
290TYPE(c_ptr),
INTENT(in) :: string
291INTEGER,
INTENT(in) :: fixlen
292CHARACTER(len=fixlen) :: fchar
294CHARACTER(len=fixlen),
POINTER :: pfchar
297safelen = min(
strlen(string), fixlen)
300IF (c_associated(string))
THEN
301 CALL c_f_pointer(string, pfchar)
302 fchar(1:safelen) = pfchar(1:safelen)
305END FUNCTION strtofchar_ptr_2
312FUNCTION fchartostr(fchar)
RESULT(string)
316CHARACTER(len=*),
INTENT(in) :: fchar
317CHARACTER(kind=c_char,len=LEN(fchar)+1) :: string
319string = fchar//char(0)
321END FUNCTION fchartostr
329FUNCTION fchartrimtostr(fchar)
RESULT(string)
333CHARACTER(len=*),
INTENT(in) :: fchar
334CHARACTER(kind=c_char,len=LEN_TRIM(fchar)+1) :: string
336string = trim(fchar)//char(0)
338END FUNCTION fchartrimtostr
341SUBROUTINE strtofchararr_assign(fchar, string)
345CHARACTER(kind=c_char,len=1),
ALLOCATABLE,
INTENT(out) :: fchar(:)
346TYPE(c_ptr),
INTENT(in) :: string
348CHARACTER(kind=c_char),
POINTER :: pstring(:)
352CALL c_f_pointer(string, pstring, (/l/))
356END SUBROUTINE strtofchararr_assign
365FUNCTION c_ptr_ptr_new_from_c(c_ptr_ptr_c)
RESULT(this)
369TYPE(c_ptr),
VALUE :: c_ptr_ptr_c
373TYPE(c_ptr),
POINTER :: charp(:)
375IF (c_associated(c_ptr_ptr_c))
THEN
377 CALL c_f_pointer(c_ptr_ptr_c, charp, (/huge(1)/))
378 DO i = 1,
SIZE(charp)
379 IF (.NOT.c_associated(charp(i)))
THEN
380 CALL c_f_pointer(c_ptr_ptr_c, this%elem, (/i/))
385END FUNCTION c_ptr_ptr_new_from_c
394FUNCTION c_ptr_ptr_new_from_fchar(fchar)
RESULT(this)
395CHARACTER(len=*) :: fchar(:)
398INTEGER :: i, j, totlen
402 totlen = totlen + len_trim(fchar(i)) + 1
404ALLOCATE(this%buffer(totlen), this%elem(
SIZE(fchar) + 1))
407 this%elem(i) = c_loc(this%buffer(totlen))
408 DO j = 1, len_trim(fchar(i))
409 this%buffer(totlen) = fchar(i)(j:j)
412 this%buffer(totlen) = char(0)
415this%elem(i) = c_null_ptr
417END FUNCTION c_ptr_ptr_new_from_fchar
423FUNCTION c_ptr_ptr_getsize(this)
428INTEGER :: c_ptr_ptr_getsize
430IF (
ASSOCIATED(this%elem))
THEN
431 c_ptr_ptr_getsize =
SIZE(this%elem) - 1
433 c_ptr_ptr_getsize = 0
436END FUNCTION c_ptr_ptr_getsize
446FUNCTION c_ptr_ptr_getptr(this, n)
451INTEGER,
INTENT(in) :: n
452TYPE(c_ptr) :: c_ptr_ptr_getptr
454c_ptr_ptr_getptr = c_null_ptr
455IF (
ASSOCIATED(this%elem))
THEN
456 IF (n > 0 .AND. n <=
SIZE(this%elem))
THEN
457 c_ptr_ptr_getptr = this%elem(n)
461END FUNCTION c_ptr_ptr_getptr
467FUNCTION c_ptr_ptr_getobject(this)
469TYPE(c_ptr) :: c_ptr_ptr_getobject
471c_ptr_ptr_getobject = c_null_ptr
472IF (
ASSOCIATED(this%elem))
THEN
473 c_ptr_ptr_getobject = c_loc(this%elem(1))
476END FUNCTION c_ptr_ptr_getobject
Constructor for a c_ptr_ptr object.
Equivalent of the strlen C function.
Convert a null-terminated C string into a Fortran CHARACTER variable of the proper length.
Utility module for supporting Fortran 2003 C language interface module.
Fortran derived type for handling void**, char**, etc C objects (pointer to pointer or array of point...