1!
2! CDDL HEADER START
3!
4! The contents of this file are subject to the terms of the Common Development
5! and Distribution License Version 1.0 (the "License").
6!
7! You can obtain a copy of the license at
8! http://www.opensource.org/licenses/CDDL-1.0.  See the License for the
9! specific language governing permissions and limitations under the License.
10!
11! When distributing Covered Code, include this CDDL HEADER in each file and
12! include the License file in a prominent location with the name LICENSE.CDDL.
13! If applicable, add the following below this CDDL HEADER, with the fields
14! enclosed by brackets "[]" replaced with your own identifying information:
15!
16! Portions Copyright (c) [yyyy] [name of copyright owner]. All rights reserved.
17!
18! CDDL HEADER END
19!
20
21!
22! Copyright (c) 2016--2020, Regents of the University of Minnesota.
23! All rights reserved.
24!
25! Contributors:
26!    Ryan S. Elliott
27!
28
29!
30! Release: This file is part of the kim-api-2.2.1 package.
31!
32
33module kim_convert_string_module
34  implicit none
35  private
36
37  public &
38    kim_convert_c_char_array_to_string, &
39    kim_convert_c_char_ptr_to_string, &
40    kim_convert_string_to_c_char_array
41
42contains
43  recursive subroutine kim_convert_c_char_array_to_string(c_char_array, string)
44    use, intrinsic :: iso_c_binding
45    implicit none
46    character(len=1, kind=c_char), intent(in) :: c_char_array(:)
47    character(len=*, kind=c_char), intent(out) :: string
48
49    integer(c_int) :: i
50    integer(c_int) :: null_index
51    integer(c_int) :: length
52
53    length = len(string) + 1
54    do null_index = 1, length
55      if (c_char_array(null_index) == c_null_char) exit
56    end do
57    if (null_index == length) then
58      null_index = len(string)
59    else
60      null_index = null_index - 1
61    end if
62    string = ""
63    do i = 1, null_index
64      string(i:i) = c_char_array(i)
65    end do
66  end subroutine kim_convert_c_char_array_to_string
67
68  recursive subroutine kim_convert_c_char_ptr_to_string(c_char_ptr, string)
69    use, intrinsic :: iso_c_binding
70    implicit none
71    type(c_ptr), intent(in) :: c_char_ptr
72    character(len=*, kind=c_char), intent(out) :: string
73
74    character(len=1, kind=c_char), pointer :: fp(:)
75    integer(c_int) :: length
76
77    if (c_associated(c_char_ptr)) then
78      length = len(string) + 1
79      call c_f_pointer(c_char_ptr, fp, [length])
80      call kim_convert_c_char_array_to_string(fp, string)
81    else
82      string = ""
83    end if
84  end subroutine kim_convert_c_char_ptr_to_string
85
86  recursive subroutine kim_convert_string_to_c_char_array(string, c_char_array)
87    use, intrinsic :: iso_c_binding
88    implicit none
89    character(len=*, kind=c_char), intent(in) :: string
90    character(len=1, kind=c_char), intent(out) :: c_char_array(:)
91
92    c_char_array(:) = trim(string)//c_null_char
93  end subroutine kim_convert_string_to_c_char_array
94end module kim_convert_string_module
95