|
XBeach
|
00001 module mnemiso_module 00002 use iso_c_binding 00003 use mnemmodule 00004 implicit none 00005 save 00006 00007 00008 type, bind(c) :: b_arraytype 00009 00010 character(kind=c_char) type ! 'i' or 'r': integer or real*8 00011 character(kind=c_char) btype ! 'b' or 'd': 00012 integer(c_int) rank ! 0,1,2,3,4 00013 character(kind=c_char, len=maxnamelen) :: name ! 'v','ve', ..... 00014 character(kind=c_char, len=20) :: units ! m, following udunits convention 00015 character(kind=c_char, len=1024) :: description 00016 character(kind=c_char, len=20), dimension(maxrank) :: dimensions ! the dimensions of the variable, for example (s%nx, s%ny) 00017 00018 type (c_ptr) :: array 00019 00020 end type b_arraytype 00021 00022 type, bind(c) :: carraytype 00023 00024 integer(c_int) rank ! 0,1,2,3,4 00025 character(kind=c_char) type ! 'i' or 'r': integer or real*8 00026 character(kind=c_char) btype ! 'b' or 'd' '2': broadcast or distribute or 00027 type(c_ptr) :: array 00028 00029 end type carraytype 00030 00031 contains 00032 type(carraytype) function arrayf2c(farray) 00033 type(arraytype), intent(in) :: farray 00034 real(c_double), target :: a(3) 00035 a = (/ 1.0d0, 2.0d0, 3.0d0 /) 00036 arrayf2c%type = farray%type 00037 arrayf2c%btype = farray%btype 00038 arrayf2c%rank = farray%rank 00039 ! if (farray%type == 'd' .and. farray%rank == 2) then 00040 ! call c_f_pointer(arrayf2c%array, farray%r2, shape=shape(farray%r2)) 00041 ! else 00042 ! arrayf2c%array =C_NULL_PTR 00043 ! end if 00044 arrayf2c%array = c_loc(a) 00045 end function arrayf2c 00046 00047 00048 00049 ! Utility functions 00050 integer(c_int) function stringlength(char_array) 00051 character(c_char), intent(in) :: char_array(:) 00052 integer :: i 00053 stringlength = 0 00054 do i = 1, size(char_array) 00055 if (char_array(i) .eq. C_NULL_CHAR) then 00056 stringlength = i 00057 end if 00058 end do 00059 stringlength = size(char_array) 00060 00061 end function stringlength 00062 00063 ! function char_array_to_string(char_array, length) 00064 ! integer(c_int) :: length 00065 ! character(c_char) :: char_array(length) 00066 ! character(len=length) :: char_array_to_string 00067 ! integer :: i 00068 ! do i = 1, length 00069 ! char_array_to_string(i:i) = char_array(i) 00070 ! enddo 00071 ! end function char_array_to_string 00072 ! function string_to_char_array(string, length) 00073 ! character(len=length) :: string 00074 ! character(kind=c_char,len=1) :: string_to_char_array(length+1) 00075 ! integer(c_int) :: length 00076 ! integer :: i 00077 ! do i = 1, length 00078 ! string_to_char_array(i) = string(i:i) 00079 ! enddo 00080 ! string_to_char_array(length+1) = C_NULL_CHAR 00081 ! end function string_to_char_array 00082 00083 00084 ! FUNCTION C_F_STRING(CPTR) RESULT(FPTR) 00085 ! ! Convert a null-terminated C string into a Fortran character array pointer 00086 ! TYPE(C_PTR), INTENT(IN) :: CPTR ! The C address 00087 ! CHARACTER(KIND=C_CHAR), DIMENSION(:), POINTER :: FPTR 00088 ! 00089 ! INTERFACE ! strlen is a standard C function from <string.h> 00090 ! ! int strlen(char *string) 00091 ! FUNCTION strlen(string) RESULT(len) BIND(C,NAME="strlen") 00092 ! USE ISO_C_BINDING 00093 ! TYPE(C_PTR), VALUE :: string ! A C pointer 00094 ! END FUNCTION 00095 ! END INTERFACE 00096 ! 00097 ! IF(C_ASSOCIATED(CPTR)) THEN 00098 ! CALL C_F_POINTER(FPTR=FPTR, CPTR=CPTR, SHAPE=[strlen(CPTR)]) 00099 ! ELSE 00100 ! ! To avoid segfaults, associate FPTR with a dummy target: 00101 ! FPTR=>dummy_string 00102 ! END IF 00103 ! 00104 ! END FUNCTION 00105 end module mnemiso_module
1.7.6.1
