cmiss_fortran_c.f90

Go to the documentation of this file.

#include "dllexport.h"

MODULE cmiss_fortran_c

  USE iso_c_binding
 
  IMPLICIT NONE

  PRIVATE

  !Module parameters

  !Module types

  !Module variables

  !Interfaces

  PUBLIC cmissc2fstring

  PUBLIC cmissf2cstring

  PUBLIC cmissc2fstrings

CONTAINS

  !
  !================================================================================================================================
  !

  SUBROUTINE cmissc2fstring(Cstring,Fstring)
    !DLLEXPORT(CMISSC2FString)
    !Argument variables
    CHARACTER(LEN=1,KIND=C_CHAR), INTENT(IN) :: Cstring(:)
    CHARACTER(LEN=*), INTENT(OUT) :: Fstring
    !Local variables
    INTEGER(C_INT) :: i,LENGTH

    IF(len(fstring)>=SIZE(cstring,1)-1) THEN
      length=SIZE(cstring,1)-1
    ELSE
      length=len(fstring)
    ENDIF
    fstring=""
    DO i=1,length
      IF(cstring(i)==c_null_char) THEN
        EXIT
      ELSE
        fstring(i:i)=cstring(i)
      ENDIF
    ENDDO !i
    
    RETURN
    
  END SUBROUTINE cmissc2fstring
   
  !
  !================================================================================================================================
  !

  SUBROUTINE cmissf2cstring(Fstring,Cstring)
    !DLLEXPORT(CMISSF2CString)
    !Argument variables
    CHARACTER(LEN=*), INTENT(IN) :: Fstring
    CHARACTER(LEN=1,KIND=C_CHAR), INTENT(OUT) :: Cstring(:)
    !Local variables
    INTEGER(C_INT) :: i,LENGTH

    IF(SIZE(cstring,1)>len_trim(fstring)) THEN
      length=len_trim(fstring)
    ELSE
      length=SIZE(cstring,1)-1
    ENDIF
    DO i=1,length     
      cstring(i)=fstring(i:i)
    ENDDO !i
    !Null terminate the string
    cstring(length+1)=c_null_char
    
    RETURN
    
  END SUBROUTINE cmissf2cstring
   
  !
  !================================================================================================================================
  !

  SUBROUTINE cmissc2fstrings(Cstrings,Fstrings)
    !DLLEXPORT(CMISSC2FStrings)
    !Argument variables
    CHARACTER(LEN=1,KIND=C_CHAR), INTENT(IN) :: Cstrings(:,:)
    CHARACTER(LEN=*), INTENT(INOUT) :: Fstrings(:)
    !Local variables
    INTEGER(C_INT) :: string_idx,i
    INTEGER(C_INT) :: LENGTH=0

    !Cstrings array index order is opposite to C
    IF(len(fstrings(1))>=SIZE(cstrings,1)-1) THEN
      length=SIZE(cstrings,1)-1
    ELSE
      length=len(fstrings(1))
    ENDIF
    DO string_idx=1,SIZE(fstrings,1)
      fstrings(string_idx)=" "
      DO i=1,length
        IF(cstrings(i,string_idx)==c_null_char) THEN
          EXIT
        ELSE
          fstrings(string_idx)(i:i)=cstrings(i,string_idx)
        ENDIF
      ENDDO !i
    ENDDO

    RETURN

  END SUBROUTINE cmissc2fstrings

  !
  !=================================================================================================================================
  !

END MODULE cmiss_fortran_c