[6331] | 1 | ! pyOASIS - A Python wrapper for OASIS |
---|
| 2 | ! Authors: Philippe Gambron, Rupert Ford |
---|
| 3 | ! Copyright (C) 2019 UKRI - STFC |
---|
| 4 | |
---|
| 5 | ! This program is free software: you can redistribute it and/or modify |
---|
| 6 | ! it under the terms of the GNU Lesser General Public License as |
---|
| 7 | ! published by the Free Software Foundation, either version 3 of the |
---|
| 8 | ! License, or any later version. |
---|
| 9 | |
---|
| 10 | ! This program is distributed in the hope that it will be useful, |
---|
| 11 | ! but WITHOUT ANY WARRANTY; without even the implied warranty of |
---|
| 12 | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
---|
| 13 | ! GNU Lesser General Public License for more details. |
---|
| 14 | |
---|
| 15 | ! A copy of the GNU Lesser General Public License, version 3, is supplied |
---|
| 16 | ! with this program, in the file lgpl-3.0.txt. It is also available at |
---|
| 17 | ! <https://www.gnu.org/licenses/lgpl-3.0.html>. |
---|
| 18 | |
---|
| 19 | #define MAX_LENGTH 1000 |
---|
| 20 | |
---|
| 21 | |
---|
| 22 | module cbindings |
---|
| 23 | implicit none |
---|
| 24 | contains |
---|
| 25 | |
---|
| 26 | subroutine foasis_string_to_fortran(string_c, string_f) |
---|
| 27 | use iso_c_binding, only: c_int, c_ptr, c_f_pointer, C_NULL_CHAR |
---|
| 28 | implicit none |
---|
| 29 | type(c_ptr), intent(in) :: string_c |
---|
| 30 | character, pointer :: p_char(:) |
---|
| 31 | character(MAX_LENGTH) :: long_string |
---|
| 32 | character :: char |
---|
| 33 | character(len=:), allocatable, intent(out) :: string_f |
---|
| 34 | integer i |
---|
| 35 | |
---|
| 36 | call c_f_pointer(string_c, p_char, [MAX_LENGTH]) |
---|
| 37 | |
---|
| 38 | do i=1, MAX_LENGTH |
---|
| 39 | char=p_char(i) |
---|
| 40 | if (char==C_NULL_CHAR) then |
---|
| 41 | exit |
---|
| 42 | end if |
---|
| 43 | long_string(i:i)=char |
---|
| 44 | end do |
---|
| 45 | |
---|
| 46 | allocate(character(len=i-1) :: string_f) |
---|
| 47 | string_f=long_string(1:i-1) |
---|
| 48 | end subroutine foasis_string_to_fortran |
---|
| 49 | |
---|
| 50 | subroutine foasis_stringarray_to_fortran(n, string_c, string_f) |
---|
| 51 | use iso_c_binding, only: c_int, c_ptr, c_char, c_f_pointer, C_NULL_CHAR |
---|
| 52 | implicit none |
---|
| 53 | integer, intent(in) :: n |
---|
| 54 | type(c_ptr), dimension(n), intent(in) :: string_c |
---|
| 55 | character, pointer :: p_char(:) |
---|
| 56 | character(len=:), dimension(:), allocatable, intent(out) :: string_f |
---|
| 57 | integer :: ib_str, i, strlen, maxlen |
---|
| 58 | |
---|
| 59 | maxlen = 0 |
---|
| 60 | do ib_str = 1, n |
---|
| 61 | call c_f_pointer(string_c(ib_str), p_char, [MAX_LENGTH]) |
---|
| 62 | strlen = 0 |
---|
| 63 | do i = 1, MAX_LENGTH |
---|
| 64 | if (p_char(i)/=C_NULL_CHAR) strlen = strlen + 1 |
---|
| 65 | if (p_char(i)==C_NULL_CHAR) exit |
---|
| 66 | end do |
---|
| 67 | maxlen = max(maxlen, strlen) |
---|
| 68 | end do |
---|
| 69 | |
---|
| 70 | allocate(character(len=maxlen) :: string_f(n)) |
---|
| 71 | string_f(:) = ' ' |
---|
| 72 | do ib_str = 1, n |
---|
| 73 | call c_f_pointer(string_c(ib_str), p_char, [MAX_LENGTH]) |
---|
| 74 | strlen = 0 |
---|
| 75 | do i = 1, MAX_LENGTH |
---|
| 76 | if (p_char(i)/=C_NULL_CHAR) then |
---|
| 77 | strlen = strlen + 1 |
---|
| 78 | string_f(ib_str)(strlen:strlen) = p_char(i) |
---|
| 79 | end if |
---|
| 80 | if (p_char(i)==C_NULL_CHAR) exit |
---|
| 81 | end do |
---|
| 82 | end do |
---|
| 83 | |
---|
| 84 | end subroutine foasis_stringarray_to_fortran |
---|
| 85 | |
---|
| 86 | subroutine foasis_string_to_c(string_f, string_c) |
---|
| 87 | use iso_c_binding, only: c_ptr, c_f_pointer, C_NULL_CHAR |
---|
| 88 | implicit none |
---|
| 89 | CHARACTER(len=*), intent(in) :: string_f |
---|
| 90 | character, pointer :: p_char(:) |
---|
| 91 | type(c_ptr), target, intent(out) :: string_c |
---|
| 92 | integer i, length |
---|
| 93 | |
---|
| 94 | length=len(string_f) |
---|
| 95 | call c_f_pointer(string_c, p_char, [length]) |
---|
| 96 | do i=1,length |
---|
| 97 | p_char(i)=string_f(i:i) |
---|
| 98 | end do |
---|
| 99 | p_char(length+1)=C_NULL_CHAR |
---|
| 100 | end subroutine foasis_string_to_c |
---|
| 101 | |
---|
| 102 | end module cbindings |
---|