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