Fortran Tip集: C との相互利用可能性の例

19 C との相互利用可能性の例

Fortran 2003 から導入された機能「C との相互利用可能性（Interoperability with C）」を用いて、Fortran の手続から C の関数を呼び出したり、C の関数から Fortran の手続を呼び出したりすることができます。Fortran プログラムの言語要素を所定の構文を用いて C プログラムの言語要素に対応させる（相互利用可能にする）ことによってこれを実現します。Fortran 標準の文法を用いるため、安全性とポータビリティ性に優れた Fortran と C の混合プログラムの作成が可能です。

ここでは、C との相互利用可能性について、いくつかのプログラム例を示します。

※　文法の詳細につきましては、下記の参考文献などをご参照ください。

19.1 コンパイルとリンク

Fortran ソースファイルは Fortran コンパイラでコンパイルします。
C ソースファイルは C コンパイラでコンパイルします。
最後に、各々のコンパイルで生成されたオブジェクトファイルを Fortran コンパイラでリンクして実行ファイルを生成します。
（メインプログラムが Fortran でも C でも、この手順は変わりません。）

ご利用の Fortran コンパイラに対して、対応する C コンパイラは決められているので注意してください。例えば、nAG Fortran コンパイラ（nagfor）をご利用の場合は、C コンパイラとして GNU C コンパイラ（gcc）を用いなければなりません。ご利用のコンパイラに対して、どの C コンパイラが対応しているかは、ご利用のコンパイラのマニュアルまたは製造元にご確認ください。

以下に、簡単なプログラムを用いて、コンパイルとリンクの例を示します。

※　この例では、nAG Fortran コンパイラ（nagfor）と GNU C コンパイラ（gcc）を用いていますが、適宜ご利用のコンパイラでコマンドを置き換えてください。

[ main.f90 ]

program main
  implicit none
  interface
    subroutine hello() bind(c)
    end subroutine
  end interface
  call hello
end program

[ sub.c ]

#include <stdio.h>

void hello()
{
  printf("Hello World\n");

  return;
}

1. Fortran ソースファイルのコンパイル

nagfor -c main.f90

2. C ソースファイルのコンパイル

gcc -c sub.c

3. オブジェクトファイルのリンク

nagfor -o hello.exe main.o sub.o

※　Intel Fortran コンパイラ（ifort）では、C がメインプログラムの場合は、リンクオプション “-nofor_main” を付ける必要があります。

4. 実行ファイルの実行

hello.exe

※　Unix 系（Linux，Mac OS X，Cygwin など）では ./hello.exe とします。

[ 実行例 ]

Hello World

19.2 その他のキーポイント

Fortran の手続を C と相互利用可能にするには bind 属性が必要です。また、C との相互利用可能性に必要な言語要素 (a) ～ (f) が Fortran 標準の組込みモジュール iso_c_binding に提供されます。

(a) 表１の第１列と表２の第２列に挙げた名前付き定数

(b) 派生型 c_ptr，c_funptr

(d) c_funptr 型の名前付き定数 c_null_funptr

(e) 問合せ関数 c_loc (x)，c_funloc (x)，c_associated (c_ptr1[, c_ptr2])

(f) サブルーチン c_f_pointer (cptr, fptr[, shape])，c_f_procpointer (cptr, fptr)

これらの言語要素を利用するには、モジュール iso_c_binding を use する必要があります。

use iso_c_binding

表１ — 特別な意味をもつ C の文字の名前

名前	C の規定	c_cahr = -1	c_char /= -1
c_null_char	ナル文字	char(0)	'\0'
c_alert	警報	achar(7)	'\a'
c_backspace	後退	achar(8)	'\b'
c_formfeed	書式送り	achar(12)	'\f'
c_new_line	改行	achar(10)	'\n'
c_carriage_return	復帰	achar(13)	'\r'
c_horizontal_tab	水平タブ	achar(9)	'\t'
c_vertical_tab	垂直タブ	achar(11)	'\v'

表２ — Fortran の型と C の型との相互利用可能性

Fortran の型	種別型パラメタ	C の型
integer	c_int	int
	c_short	short int
	c_long	long int
	c_long_long	long long int
	c_signed_char	signed char, unsigned char
	c_size_t	size_t
	c_int8_t	int8_t
	c_int16_t	int16_t
	c_int32_t	int32_t
	c_int64_t	int64_t
	c_int_least8_t	int_least8_t
	c_int_least16_t	int_least16_t
	c_int_least32_t	int_least32_t
	c_int_least64_t	int_least64_t
	c_int_fast8_t	int_fast8_t
	c_int_fast16_t	int_fast16_t
	c_int_fast32_t	int_fast32_t
	c_int_fast64_t	int_fast64_t
	c_intmax_t	intmax_t
	c_intptr_t	intptr_t
real	c_float	float
	c_double	double
	c_long_double	long double
complex	c_float_complex	float _Complex
	c_double_complex	double _Complex
	c_long_double_complex	long double _Complex
logical	c_bool	_Bool
character	c_char	char

C のポインタ型との相互利用可能性

派生型 c_ptr は、すべての C のオブジェクトポインタ型と相互利用可能です。
派生型 c_funptr は、すべての C の関数ポインタ型と相互利用可能です。
c_ptr 型の名前付き定数 c_null_ptr の値は、C の NULL と同じです。
c_funptr 型の名前付き定数 c_null_funptr の値は、C の空ポインタの値と同じです。

c_loc (x) は問合せ関数です。引数 x の C アドレス（c_ptr 型のスカラ）を返します。
引数 x は次の (1) または (2) のいずれかです。

(1)　相互利用可能な型および型パラメタを持ち、そして、
　(a)　target 属性を持ち、相互利用可能な変数
　(b)　target 属性を持ち、大きさゼロの配列でない割り付けられている割付け変数
　(c)　結合したスカラポインタ
(2)　非多相的なスカラであり、長さ型パラメタを持たず、そして、
　(a)　target 属性を持ち、割付け変数でなくポインタでない変数
　(b)　target 属性を持ち、割り付けられている割付け変数
　(c)　結合したポインタ

c_funloc (x) は問合せ関数です。引数 x の C アドレス（c_funptr 型のスカラ）を返します。
引数 x は相互利用可能な手続、又は、相互利用可能な手続と結合した手続ポインタです。

c_associated (c_ptr1[, c_ptr2]) は問合せ関数です。基本論理型スカラを返します。引数 c_ptr1 と c_ptr2（省略可能）は c_ptr 型または c_funptr 型のスカラです。c_ptr1 と c_ptr2 は同じ型でなければなりません。c_ptr1 が C の空ポインタであるか、又は、c_ptr1 と異なる値を持つ c_ptr2 が存在する場合は “偽” で、それ以外は “真” です。

c_f_pointer (cptr, fptr[, shape]) はサブルーチンです。次の引数を持ちます。

cptr は intent(in) の c_ptr 型のスカラです。その値は次のいずれかです。
(1)　相互利用可能なデータ要素の C アドレス
(2)　相互利用可能ではない引数を持った c_loc の参照結果
cptr の値は target 属性を持たない Fortran 変数の C アドレスであってはいけません。
fptr は intent(out) のポインタです。
(1)　cptr の値が相互利用可能なデータ要素の C アドレスである場合、fptr はその要素の型と相互利用可能な型および型パラメタを持つデータポインタでなければなりません。この場合、fptr は cptr の指示先とポインタ結合します。fptr が配列のとき、その形状は shape によって指定され、その各下限は 1 となります。
(2)　cptr の値が相互利用可能ではない引数 x による c_loc(x) の参照結果である場合、fptr は x と同じ型および型パラメタを持った非多相的なスカラポインタでなければなりません。x または x がポインタであるときのその指示先は、開放されていてはならず、また、return 文や end 文の実行によって不定になっていてもいけません。fptr は x またはその指示先とポインタ結合します。
shape（省略可能）は intent(in) の整数型の１次元配列です。fptr が配列のときに必要で、その大きさは fptr の次元と等しくなければなりません。

c_f_procpointer (cptr, fptr) はサブルーチンです。次の引数を持ちます。

cptr は intent(in) の c_funptr 型のスカラです。その値は相互利用可能な手続の C アドレスです。
fptr は intent(out) の手続ポインタです。fptr の引用仕様は cptr の指示先と相互利用可能でなければなりません。fptr は cptr の指示先とポインタ結合します。

スカラ変数の相互利用可能性の例

Fortran の変数

real(c_double) fval

と相互利用可能な C の変数

double cval

配列変数の相互利用可能性の例

Fortran の配列

integer(c_int) fa(18, 5), fb(18, 3:7, *)

と相互利用可能な C の配列

int ca[5][18], cb[][5][18];

※　配列データのメモリへの格納は、Fortran は列優先（Column-major）で、C は行優先（Row-major）です。

派生型と C の構造体型との相互利用可能性の例

Fortran の派生型

type, bind(c) :: myftype
  integer(c_int) i, j
  real(c_float) s
end type

と相互利用可能な C の構造体型

typedef struct {
  int m, n;
  float r;
} myctype;

手続引用仕様と C の関数プロトタイプとの相互利用可能性の例

Fortran の手続（関数）引用仕様

interface
  function func(i, j, k, l, m) bind(c, name='Func')
    use iso_c_binding
    integer(c_short) func
    integer(c_int), value :: i
    real(c_double) j
    integer(c_int) k, l(10)
    type(c_ptr), value :: m
  end function
end interface

と相互利用可能な C の関数プロトタイプ

short int Func(int i, double *j, int *k, int l[10], void *m);

※　基本的に、Fortran の引数は「参照渡し」で、C の引数は「値渡し」です。value 属性は引数が「値渡し」されることを指示します。

※　名前の大文字小文字を Fortran は区別しませんが、C は区別します。例えば、“func” と “Func” は、Fortran では同じ名前ですが、C では異なる名前です。

Fortran の手続（サブルーチン）引用仕様

interface
  subroutine Copy(in, out) bind(c)
    use iso_c_binding
    character(kind=c_char), dimension(*) :: in, out
  end subroutine
end interface

と相互利用可能な C の関数プロトタイプ

void copy(char in[], char out[]);

※　サブルーチンに対する関数プロトタイプの戻り値は void です。

※　bind 属性で name 指定子を省略した場合、手続名を小文字にした名前がデフォルトで name 指定子に設定されます。つまりここでは、bind(c, name='copy') と同じことです。

大域的変数の相互利用可能性の例

Fortran のモジュール変数

module global_data
  use iso_c_binding
  integer(c_int), bind(c) :: c_extern
  integer(c_long) c2
  bind(c, name='myVariable') c2
  common /com/ r, s
  real(c_float) r, s
  bind(c) /com/
end module

と相互利用可能な C の外部変数

int c_extern;
long myVariable
struct {float r, s;} com;

文字列に関する注意

C の文字列は、ナル文字 '\0' で最後の有効な要素を示す文字型の配列です。従って、Fortran から C の関数に文字列を渡す場合は、終端にナル文字を付ける必要があることに注意してください。例えば、

c_char_'Hello World' // c_null_char

その他、文法の詳細につきましては、下記の参考文献などをご参照ください。

19.3 参考文献

[1] JIS X 3001-1:2009 (ISO/IEC 1539-1:2004) プログラム言語 Fortran — 第１部：基底言語，日本規格協会

[2] Michael Metcalf，John Reid，Malcolm Cohen，“Modern Fortran explained”，Oxford University Press

19.4 Fortran から C を呼び出す例： Hello World

[ main.f90 ]

program main
  implicit none
  interface
    subroutine hello() bind(c)
    end subroutine
  end interface
  call hello
end program

[ sub.c ]

#include <stdio.h>

void hello()
{
  printf("Hello World\n");

  return;
}

[ 実行例 ]

Hello World

19.5 Fortran から C を呼び出す例：整数型スカラの変数と値を渡す

このプログラムは、次の２つのソースファイル scalarint-f.f90（メイン），scalarint-c.c で構成されています。

[ scalarint-f.f90 ]

Program scalar_int_example
  Use Iso_C_Binding
  Implicit None
  !
  ! Demonstrates passing scalar integers to/from C.
  !
  Interface
    Function csifun(i,ierr) Bind(C)
      Import
      Integer(C_int),Value :: i
      Integer(C_int),Intent(Out) :: ierr
      Integer(C_int) csifun
    End Function
  End Interface
  !
  Integer(C_int) ierr,res
  !
  res = csifun(13_C_int,ierr)
  If (ierr/=0) Then
    Print 9000, ierr, 13
  Else
    Print 9010, 13, res
  End If
  !
  res = csifun(Huge(0_C_int),ierr)
  If (ierr/=0) Then
    Print 9000, ierr, Huge(0_C_int)
  Else
    Print 9010, Huge(0_C_int), res
  End If
9000 Format(1X,'Error ',I0,' for argument ',I0)
9010 Format(1X,'Result for ',I0,' is ',I0)
End Program

[ scalarint-c.c ]

/*
 * C function to evaluate N**2 - 1,
 * setting IFAIL to 2 to indicate overflow.
 */

#include <limits.h>

int csifun(int arg,int *ifail)
{
  if (arg==INT_MIN)
    {
      *ifail = 1;
      return 0;
    }
  if (arg<0) arg = -arg;
  if (arg>0 && (INT_MAX-1)/arg<=arg)
    {
      *ifail = 2;
      return 0;
    }
  *ifail = 0;
  return arg*arg - 1;
}

[ 実行例 ]

 Result for 13 is 168
 Error 2 for argument 2147483647

19.6 Fortran から C を呼び出す例：整数型配列を C に渡す

このプログラムは、次の２つのソースファイル intarray-f.f90（メイン），intarray-c.c で構成されています。

[ intarray-f.f90 ]

Program int_array_example
  Use Iso_C_Binding
  Implicit None
  !
  ! Demonstrates passing an integer array to C.
  !
  Interface
    Subroutine cube(ia,n) Bind(C,Name='integer_cube')
      Import
      Integer(C_int),Value :: n
      Integer(C_int),Intent(InOut) :: ia(n)
    End Subroutine
  End Interface
  !
  Integer i
  Integer(C_int) x(40)
  !
  x = [ (i-20,i=1,Size(x)) ]
  Print 9000, 'Values for X:', x
  Call cube(x,Size(x,Kind=C_int))
  Print 9000, 'Values of X cubed:', x
9000 Format(1X,A,/,(10I7))
End Program

[ intarray-c.c ]

/*
 * C function that takes an int array, and cubes each element.
 */

void integer_cube(int x[],int n)
{
  int i;
  for (i=0; i<n; i++) x[i] = x[i]*x[i]*x[i];
}

[ 実行例 ]

 Values for X:
    -19    -18    -17    -16    -15    -14    -13    -12    -11    -10
     -9     -8     -7     -6     -5     -4     -3     -2     -1      0
      1      2      3      4      5      6      7      8      9     10
     11     12     13     14     15     16     17     18     19     20
 Values of X cubed:
  -6859  -5832  -4913  -4096  -3375  -2744  -2197  -1728  -1331  -1000
   -729   -512   -343   -216   -125    -64    -27     -8     -1      0
      1      8     27     64    125    216    343    512    729   1000
   1331   1728   2197   2744   3375   4096   4913   5832   6859   8000

19.7 Fortran から C を呼び出す例：実数型配列を C に渡す

このプログラムは、次の２つのソースファイル realarray-f.f90（メイン），realarray-c.c で構成されています。

[ realarray-f.f90 ]

Program real_array_example
  Use Iso_C_Binding
  Implicit None
  !
  ! Demonstrates passing a real array to C.
  !
  Interface
    Subroutine cube(ia,n) Bind(C,Name='real_cube')
      Import
      Integer(C_size_t),Value :: n
      Real(C_float),Intent(InOut) :: ia(n)
    End Subroutine
  End Interface
  !
  Integer i
  Real(C_float) x(40)
  !
  x = [ (i-20,i=1,Size(x)) ]
  Print 9000, 'Values for X:', x
  Call cube(x,Size(x,Kind=C_size_t))
  Print 9000, 'Values of X cubed:', x
9000 Format(1X,A,/,(10F7.0))
End Program

[ realarray-c.c ]

/*
 * C function that takes a float array, and cubes each element.
 */
#include <stddef.h>

void real_cube(float x[],size_t n)
{
  size_t i;
  for (i=0; i<n; i++) x[i] = x[i]*x[i]*x[i];
}

[ 実行例 ]

 Values for X:
   -19.   -18.   -17.   -16.   -15.   -14.   -13.   -12.   -11.   -10.
    -9.    -8.    -7.    -6.    -5.    -4.    -3.    -2.    -1.     0.
     1.     2.     3.     4.     5.     6.     7.     8.     9.    10.
    11.    12.    13.    14.    15.    16.    17.    18.    19.    20.
 Values of X cubed:
 -6859. -5832. -4913. -4096. -3375. -2744. -2197. -1728. -1331. -1000.
  -729.  -512.  -343.  -216.  -125.   -64.   -27.    -8.    -1.     0.
     1.     8.    27.    64.   125.   216.   343.   512.   729.  1000.
  1331.  1728.  2197.  2744.  3375.  4096.  4913.  5832.  6859.  8000.

19.8 Fortran から C を呼び出す例：文字型スカラを C に渡す

このプログラムは、次の３つのソースファイル main.f90（メイン），util.f90，display.c で構成されています。

[ main.f90 ]

Program main
  Use util
  Implicit None
  Interface
    Subroutine display(string) Bind(C,Name='stdout_fputs')
      Character string(*)
    End Subroutine
  End Interface
  Call display(cstring('Fortran World'))
End Program

[ util.f90 ]

Module util
  Implicit None
Contains
  !
  ! Return a copy of a string with a NUL character appended, for passing to a
  ! C routine.  The result is ALLOCATABLE so the space will be automatically
  ! recovered after the call.
  !
  Function cstring(string)
    Use Iso_C_Binding
    Character(*,C_char),Intent(In) :: string
    Character(:,C_char),Allocatable :: cstring
    cstring = string//C_null_char
  End Function
End Module

[ display.c ]

/*
 * Routine to display a string on stdout,
 * prefixed with "Hello from stdout: "
 * and suffixed with a newline.
 */

#include <stdio.h>

void stdout_fputs(const char *string)
{
  fprintf(stdout,"Hello from stdout: %s\n",string);
}

[ 実行例 ]

Hello from stdout: Fortran World

19.9 Fortran から C を呼び出す例：文字型スカラのポインタを C から得る

このプログラムは、次の２つのソースファイル scalar-char-ptr_f.f90（メイン），c-month-name.c で構成されています。

[ scalar-char-ptr_f.f90 ]

Module scalar_pointer_char_wrapper
  Use Iso_C_Binding
  Implicit None
  Private
  Public c_charptr_to_f_charptr
  !
  ! Utility routine for getting character pointers from C.
  !
Contains
  !
  ! Utility routine to turn a C pointer to a null-terminated string
  ! into a Fortran CHARACTER pointer to that string.  The function
  ! returns a deferred-length CHARACTER pointer that is associated with
  ! the C string, and whose length (LEN) is the length of the string.
  !
  Function c_charptr_to_f_charptr(ccp) Result(result)
    Type(C_ptr),Intent(In),Value :: ccp
    Character(:,C_char),Pointer :: result
    Interface
      Function strlen(p) Bind(C)
        Import C_ptr,C_size_t
        Type(C_ptr),Value :: p
        Integer(C_size_t) strlen
      End Function
    End Interface
    result => convert_cptr(ccp,strlen(ccp))
  Contains
    !
    ! This uses a variable-length CHARACTER pointer because the
    ! function C_F_pointer has no other way of encoding the length.
    !
    Function convert_cptr(p,len)
      Type(C_ptr),Intent(In) :: p
      Integer(C_size_t),Intent(In) :: len
      Character(len,C_char),Pointer :: convert_cptr
      Call C_F_pointer(p,convert_cptr)
    End Function
  End Function
End Module
Module month_name_module
  Implicit None
Contains
  !
  ! This wraps the C function, and turns the C pointer result into a
  ! deferred-length Fortran CHARACTER pointer.
  !
  ! It returns the name of the months 1-12.
  !
  Function month_name(month)
    Use scalar_pointer_char_wrapper
    Use Iso_C_Binding
    Integer,Intent(In) :: month
    Character(:,C_char),Pointer :: month_name
    Interface
      !
      ! This is the C function we will call; it returns a pointer to
      ! the month name; it expects the months are 0-11.
      !
      Function c_month_name(m) Bind(C,Name='MonthName')
        Import C_int,C_ptr
        Integer(C_int),Value :: m
        Type(C_ptr) c_month_name
      End Function
    End Interface
    Character(7,C_char),Target :: invalid = 'INVALID'
    If (month>=1 .And. month<=12) Then
      month_name => c_charptr_to_f_charptr(c_month_name(month-1))
    Else
      month_name => invalid
    End If
  End Function
End Module
!
! Main program to show the usage of the wrappers.
!
Program scalar_char_pointer_example
  Use Iso_C_Binding
  Use month_name_module
  Implicit None
  Character(:,C_char),Pointer :: longest => Null(),this
  Integer i
  Do i=1,12
    this => month_name(i)
    Print 1,i,this
1   Format(1X,'The name of month ',I0,' is ',A)
    If (.Not.Associated(longest)) Then
      longest => this
    Else If (Len(longest)<Len(this)) Then
      longest => this
    End If
  End Do
  Print *,'The month with the longest name is ',longest
End Program

[ c-month-name.c ]

/*
 * C function to return the name of the month,
 * where month 0 is January, and December is month 11.
 */

 static char *month_name_strings[] = {
   "January",
   "February",
   "March",
   "April",
   "May",
   "June",
   "July",
   "August",
   "September",
   "October",
   "November",
   "December"
};

const char *MonthName(int i)
{
  return month_name_strings[i];
}

[ 実行例 ]

 The name of month 1 is January
 The name of month 2 is February
 The name of month 3 is March
 The name of month 4 is April
 The name of month 5 is May
 The name of month 6 is June
 The name of month 7 is July
 The name of month 8 is August
 The name of month 9 is September
 The name of month 10 is October
 The name of month 11 is November
 The name of month 12 is December
 The month with the longest name is September

19.10 Fortran から C を呼び出す例： C の連結リストの生成と走査

このプログラムは、次の５つのソースファイル fmain.f90（メイン），flist.f90，list.h，makelist.c，example-list.c で構成されています。

[ fmain.f90 ]

Program linked_list_example
  Use flist
  Implicit None
  Interface
    Function make_example_list() Bind(C)
      Import
      Type(list_t) make_example_list
    End Function
  End Interface
  Type(list_t) c_list, f_list
  Real(C_double) x
  !
  ! Get an example list from C and display it.
  !
  c_list = make_example_list()
  Call show_list('C list',c_list)
  !
  ! Make an example list in Fortran and display it.
  !
  f_list = new_list()
  x = -1.5_C_double
  Call append_new_element_to_list(f_list,x)
  Call append_new_element_to_list(f_list,x**2)
  Call append_new_element_to_list(f_list,x**3)
  Call append_new_element_to_list(f_list,x**4)
  Call append_new_element_to_list(f_list,x**5)
  Call show_list('Fortran list',f_list)
  !
  ! Destroy both lists.
  ! Note the correct routine must be used for each list.
  !
  Call destroy_c_list(c_list)
  Call destroy_f_list(f_list)
End Program

[ flist.f90 ]

Module flist
  Use Iso_C_Binding
  Implicit None
  !
  ! Fortran module corresponding to a C linked list.
  !
  Type,Bind(C) :: element_t
    Real(C_double) value
    Type(C_ptr) prev,next
  End Type
  Type,Bind(C) :: list_t
    Type(C_ptr) first
  End Type
Contains
  !
  ! Basic traversal functions.
  !
  Function first(list)
    Type(list_t),Intent(In) :: list
    Type(element_t),Pointer :: first
    Call C_F_Pointer(list%first,first)
  End Function
  !
  Function next(element)
    Type(element_t),Intent(In) :: element
    Type(element_t),Pointer :: next
    Call C_F_Pointer(element%next,next)
  End Function
  !
  Function prev(element)
    Type(element_t),Intent(In) :: element
    Type(element_t),Pointer :: prev
    Call C_F_Pointer(element%prev,prev)
  End Function
  !
  ! List creation procedures.
  !
  Type(list_t) Function new_list()
    new_list%first = C_null_ptr
  End Function
  !
  ! Create a new element and append it to the list.
  !
  Subroutine append_new_element_to_list(list,value)
    Type(list_t),Intent(InOut) :: list
    Real(C_double),Intent(In) :: value
    Type(element_t),Pointer :: element,p,q
    Allocate(element)
    element%next = C_null_ptr
    element%value = value
    p => first(list)
    If (Associated(p)) Then
      q => prev(p)
      element%prev = C_Loc(q)
      q%next = C_Loc(element)
      p%prev = C_loc(element)
    Else
      list%first = C_Loc(element)
      element%prev = C_Loc(element)
    End If
  End Subroutine
  !
  ! Display a list.
  !
  Subroutine show_list(name,list)
    Character(*),Intent(In) :: name
    Type(list_t),Intent(In) :: list
    Type(element_t),Pointer :: element
    element => first(list)
    Print *,'Contents of list ',name
    Do While (Associated(element))
      print *,'   Element:',element%value
      element => next(element)
    End Do
    Print *,'   End of list.'
  End Subroutine
  !
  ! Destroy a list that was created in C.
  !
  ! A list that was allocated via C "malloc"
  ! must be deallocated via C "free".
  !
  Subroutine destroy_c_list(list)
    Type(list_t),Intent(InOut) :: list
    Type(element_t),Pointer :: p,nextp
    Interface
      Subroutine free(loc) Bind(C)
        Import
        Type(C_ptr),Value :: loc
      End Subroutine
    End Interface
    p => first(list)
    Do While(Associated(p))
      nextp => next(p)
      Call free(C_loc(p))
      p => nextp
    End Do
  End Subroutine
  !
  ! Destroy a list that was created in Fortran.
  !
  ! A list that was allocated via Fortran ALLOCATE
  ! must be deallocated via Fortran DEALLOCATE.
  !
  Subroutine destroy_f_list(list)
    Type(list_t),Intent(InOut) :: list
    Type(element_t),Pointer :: p,nextp
    p => first(list)
    Do While(Associated(p))
      nextp => next(p)
      Deallocate(p)
      p => nextp
    End Do
  End Subroutine
End Module

[ list.h ]

/*
 * list.h - Linked-list definition.
 */

/*
 * Doubly-linked linear list, with a double value in each element.
 *
 * The prev pointers will be circular, to make it fast to find the last element.
 */
typedef struct list_element {
  double value;
  struct list_element *prev,*next;
} Element;

typedef struct list_head {
  struct list_element *first;
} List;

/*
 * List creation function declarations.
 */
Element *new_element(double value);
List new_list(void);
void append(List *list,Element *element);

[ makelist.c ]

/*
 * C functions for list making.
 */

#include <stdlib.h>
#include "list.h"

Element *new_element(double value)
{
  Element *result = (Element *)malloc(sizeof(Element));
  result->value = value;
  result->next = (Element *)0;
  result->prev = (Element *)0;
  return result;
}

List new_list(void)
{
  List result;
  result.first = (Element *)0;
  return result;
}

void append(List *list,Element *element)
{
  if (list->first)
    {
      Element *last = list->first->prev;
      last->next = element;
      element->prev = last;
      list->first->prev = element;
    }
  else
    {
      list->first = element;
      element->prev = element;
    }
  element->next = (Element *)0;
}

[ example-list.c ]

/*
 * example_list.c - make an example list.
 */

#include "list.h"

List make_example_list(void)
{
  List result = new_list();
  append(&result,new_element(1.5));
  append(&result,new_element(2.0));
  append(&result,new_element(3.0));
  append(&result,new_element(4.5));
  append(&result,new_element(6.5));
  return result;
}

[ 実行例 ]

 Contents of list C list
    Element:   1.5000000000000000
    Element:   2.0000000000000000
    Element:   3.0000000000000000
    Element:   4.5000000000000000
    Element:   6.5000000000000000
    End of list.
 Contents of list Fortran list
    Element:  -1.5000000000000000
    Element:   2.2500000000000000
    Element:  -3.3750000000000000
    Element:   5.0625000000000000
    Element:  -7.5937500000000000
    End of list.

19.11 Fortran から C を呼び出す例：高度な連結リストの例

このプログラムは、次の５つのソースファイル fmain.f90（メイン），flist.f90，list.h，makelist.c，example-list.c で構成されています。

[ fmain.f90 ]

Program linked_list_example
  Use flist
  Implicit None
  Interface
    Function make_example_list() Bind(C)
      Import
      Type(list_t) make_example_list
    End Function
  End Interface
  Type(list_t) list
  Type(element_t),Pointer :: ep
  !
  ! Get an example list from C and display it.
  !
  list = make_example_list()
  Call show_list('Original example',list)
  !
  ! Delete the second item on the list.
  !
  ep => next(first(list))
  Call delete(list,ep)
  !
  ! Now insert a new item after the first item,
  ! i.e. it will be in place of the item we just deleted.
  !
  Call addnext(list,first(list),new_element(17.0_C_double))
  !
  ! And append a new item to the list.
  !
  Call append_new_element_to_list(list,-33.0_C_double)
  !
  ! Finally, display the new list
  !
  Call show_list('Revised',list)
  !
  ! Finally, delete the entire list.
  !
  Call destroy(list)
End Program

[ flist.f90 ]

Module flist
  Use Iso_C_Binding
  Implicit None
  !
  ! Fortran module corresponding to a C linked list.
  !
  Type,Bind(C) :: element_t
    Real(C_double) value
    Type(C_ptr) prev,next
  End Type
  Type,Bind(C) :: list_t
    Type(C_ptr) first
  End Type
  !
  ! Used internally.
  !
  Interface
    Subroutine free(loc) Bind(C)
      Import
      Type(C_ptr),Value :: loc
    End Subroutine
  End Interface
  Private free
Contains
  !
  ! Basic traversal functions.
  !
  Function first(list)
    Type(list_t),Intent(In) :: list
    Type(element_t),Pointer :: first
    Call C_F_Pointer(list%first,first)
  End Function
  !
  Function next(element)
    Type(element_t),Intent(In) :: element
    Type(element_t),Pointer :: next
    Call C_F_Pointer(element%next,next)
  End Function
  !
  Function prev(element)
    Type(element_t),Intent(In) :: element
    Type(element_t),Pointer :: prev
    Call C_F_Pointer(element%prev,prev)
  End Function
  !
  ! List creation procedures.
  !
  Type(list_t) Function new_list()
    new_list%first = C_null_ptr
  End Function
  !
  ! Create a single list element by itself.
  !
  Function new_element(value)
    Type(element_t),Pointer :: new_element
    Real(C_double),Intent(In) :: value
    ! This uses the C new_element function, to ensure that the whole list
    ! is allocated via C (using malloc).
    Interface
      Function c_new_element(value) Bind(C,Name='new_element')
        Import
        Real(C_double),Value :: value
        Type(C_ptr) c_new_element
      End Function
    End Interface
    Call C_F_Pointer(c_new_element(value),new_element)
  End Function
  !
  ! Create a new element and append it to the list.
  !
  Subroutine append_new_element_to_list(list,value)
    Type(list_t),Intent(InOut) :: list
    Real(C_double),Intent(In) :: value
    Type(element_t),Pointer :: element,p,q
    element => new_element(value)
    p => first(list)
    If (Associated(p)) Then
      q => prev(p)
      element%prev = C_Loc(q)
      q%next = C_Loc(element)
      p%prev = C_loc(element)
    Else
      list%first = C_Loc(element)
      element%prev = C_Loc(element)
    End If
  End Subroutine
  !
  ! Insert an item into a list, next to an existing element.
  !
  Subroutine addnext(list,old,new)
    Type(list_t),Intent(In) :: list
    Type(element_t),Intent(In),Pointer :: old,new
    Type(element_t),Pointer :: p
    If (C_associated(new%prev)) Stop 'New element already in a list'
    new%prev = C_loc(old)
    new%next = old%next
    old%next = C_loc(new)
    ! Now fix the prev pointers...
    ! ...was old the last element in the list?
    p => next(new)
    If (.Not.Associated(p)) Then
      ! Yes: so we want to act on the first element's prev pointer.
      p => first(list)
    End If
    p%prev = C_loc(new)
  End Subroutine
  !
  ! Delete an element from a list.
  !
  Subroutine delete(list,element)
    Type(list_t),Intent(InOut) :: list
    Type(element_t),Intent(InOut),Pointer :: element
    Type(element_t),Pointer :: p
    ! First, fix the "next" pointer of a previous element,
    ! or the "first" pointer of the list header.
    If (C_associated(list%first,C_loc(element))) Then
      ! Deleting the first element...
      list%first = element%next
    Else
      ! Not the first element; use prev
      p => prev(element)
      p%next = element%next
    End If
    ! Now, fix the "prev" pointer of the next/first element.
    If (C_associated(element%next)) Then
      ! Not the last element.
      p => next(element)
      p%prev = element%prev
    Else
      ! Is the last element - if the list is empty we are done.
      p => first(list)
      If (Associated(p)) p%prev = element%prev
    End If
    ! Deallocate using C "free", because it was allocated using C "malloc".
    Call free(C_loc(element))
    ! Nullify the now-dangling pointer (just as Fortran DEALLOCATE does).
    Nullify(element)
  End Subroutine
  !
  ! Display a list.
  !
  Subroutine show_list(name,list)
    Character(*),Intent(In) :: name
    Type(list_t),Intent(In) :: list
    Type(element_t),Pointer :: element
    element => first(list)
    Print *,'Contents of list ',name
    Do While (Associated(element))
      print *,'   Element:',element%value
      element => next(element)
    End Do
    Print *,'   End of list.'
  End Subroutine
  !
  ! Destroy a list.
  !
  ! Note that this uses the C "free" routine,
  ! because the list was allocated via C
  !
  Subroutine destroy(list)
    Type(list_t),Intent(InOut) :: list
    Type(element_t),Pointer :: p,nextp
    p => first(list)
    Do While(Associated(p))
      nextp => next(p)
      Call free(C_loc(p))
      p => nextp
    End Do
  End Subroutine
End Module

[ list.h ]

/*
 * list.h - Linked-list definition.
 */

/*
 * Doubly-linked linear list, with a double value in each element.
 *
 * The prev pointers will be circular, to make it fast to find the last element.
 */
typedef struct list_element {
  double value;
  struct list_element *prev,*next;
} Element;

typedef struct list_head {
  struct list_element *first;
} List;

/*
 * List creation function declarations.
 */
Element *new_element(double value);
List new_list(void);
void append(List *list,Element *element);

[ makelist.c ]

/*
 * C functions for list making.
 */

#include <stdlib.h>
#include "list.h"

Element *new_element(double value)
{
  Element *result = (Element *)malloc(sizeof(Element));
  result->value = value;
  result->next = (Element *)0;
  result->prev = (Element *)0;
  return result;
}

List new_list(void)
{
  List result;
  result.first = (Element *)0;
  return result;
}

void append(List *list,Element *element)
{
  if (list->first)
    {
      Element *last = list->first->prev;
      last->next = element;
      element->prev = last;
      list->first->prev = element;
    }
  else
    {
      list->first = element;
      element->prev = element;
    }
  element->next = (Element *)0;
}

[ example-list.c ]

/*
 * example_list.c - make an example list.
 */

#include "list.h"

List make_example_list(void)
{
  List result = new_list();
  append(&result,new_element(1.5));
  append(&result,new_element(2.0));
  append(&result,new_element(3.0));
  append(&result,new_element(4.5));
  append(&result,new_element(6.5));
  return result;
}

[ 実行例 ]

 Contents of list Original example
    Element:   1.5000000000000000
    Element:   2.0000000000000000
    Element:   3.0000000000000000
    Element:   4.5000000000000000
    Element:   6.5000000000000000
    End of list.
 Contents of list Revised
    Element:   1.5000000000000000
    Element:  17.0000000000000000
    Element:   3.0000000000000000
    Element:   4.5000000000000000
    Element:   6.5000000000000000
    Element: -33.0000000000000000
    End of list.

19.12 C から Fortran を呼び出す例： Hello World

[ main.c ]

extern void hello(void);

int main(int argc, char *argv[])
{
  hello();

  return 0;
}

[ sub.f90 ]

subroutine hello() bind(c)
  implicit none
  print *, 'Hello World'
end subroutine

[ 実行例 ]

Hello World

19.13 C から Fortran を呼び出す例： float 型（実数型）配列を Fortran に渡す

このプログラムは、次の２つのソースファイル cmain.c（メイン），dpr.f90 で構成されています。

[ cmain.c ]

#include <stdio.h>

/*
 * External Fortran function that computes the dot product
 * of two C float vectors.
 */
extern float dot_product_r(float x[],float y[],int n);

#define N_ELTS 10

int main(int argc,char *argv[])
{
  float x[N_ELTS],y[N_ELTS];
  int i;
  /*
   * Give X and Y some values.
   */
  for (i=0; i<N_ELTS; i++)
    {
      x[i] = i*0.5f;
      y[i] = N_ELTS - i*0.5f;
    }
  /*
   * Display the value of X and Y, and...
   */
  printf("Dot product of [");
  for (i=0; i<N_ELTS; i++) printf(" %g",x[i]);
  printf(" ]\nand            [");
  for (i=0; i<N_ELTS; i++) printf(" %g",y[i]);
  /*
   * Display the dot product.
   */
  printf("]\nis %g\n",dot_product_r(x,y,N_ELTS));
  return 0;
}

[ dpr.f90 ]

!
! Provide Fortran DOT_PRODUCT for C float.
!
! Prototype:
!   float dot_product_r(float x[],float y[],int n);
!
Function dot_product_r(x,y,n) Bind(C)
  Use Iso_C_Binding
  Implicit None
  Integer(C_int),Value,Intent(In) :: n
  Real(C_float),Intent(In) :: x(n),y(n)
  Real(C_float) dot_product_r
  Intrinsic Dot_Product
  dot_product_r = Dot_Product(x,y)
End Function

[ 実行例 ]

Dot product of [ 0 0.5 1 1.5 2 2.5 3 3.5 4 4.5 ]
and            [ 10 9.5 9 8.5 8 7.5 7 6.5 6 5.5]
is 153.75

19.14 C から Fortran を呼び出す例： float 型（実数型）配列のポインタを Fortran に渡す

このプログラムは、次の２つのソースファイル cmain.c（メイン），fmat.f90 で構成されています。

[ cmain.c ]

#include <stdio.h>
#include <stddef.h>
#include <stdlib.h>

/*
 * Data type for a Real (float) matrix.
 */
typedef struct {
  float *addr;
  size_t m,n;
} Matrix;

/*
 * C function to display a matrix.
 */
void show_matrix(const char *name,Matrix m);

/*
 * External Fortran function that does Matrix Multiply.
 */
extern Matrix Matrix_Multiply_r(Matrix a,Matrix b);
/*
 * External Fortran function to deallocate an matrix array pointer.
 */
extern void Fortran_Deallocate_Matrix(Matrix c);

/*
 * We will multiply a 3x4 matrix by a 4x5 matrix,
 * producing a 3x5 result.
 */

#define A_M 3
#define A_N 4

#define B_M 4
#define B_N 5

int main(int argc,char *argv[])
{
  Matrix a,b,c;
  int i,j,k;
  /*
   * Allocate and describe the input matrices.
   */
  a.m = A_M;
  a.n = A_N;
  a.addr = (float *)malloc(a.m*a.n*sizeof(float));
  b.m = B_M;
  b.n = B_N;
  b.addr = (float *)malloc(b.m*b.n*sizeof(float));
  /*
   * Give A and B some values.
   */
  k = 0;
  for (i=0; i<A_M; i++)
    for (j=0; j<A_N; j++)
      {
        a.addr[i*A_N+j] = k++;
      }
  k = 0;
  for (i=0; i<B_M; i++)
    for (j=0; j<B_N; j++)
      {
        b.addr[i*B_N+j] = k++;
      }
  /*
   * Display input matrices.
   */
  show_matrix("A",a);
  show_matrix("B",b);
  /*
   * Calculate the result.
   */
  c = Matrix_Multiply_r(a,b);
  /*
   * Show the result.
   */
  show_matrix("Product(C)",c);
  /*
   * Deallocate the input matrices; these were allocated in C,
   * therefore must be deallocated in C.
   */
  free(a.addr);
  free(b.addr);
  /*
   * Deallocate the result; this was allocated in Fortran,
   * therefore must be deallocated in Fortran.
   */
  Fortran_Deallocate_Matrix(c);
  /*
   * End of program.
   */
  return 0;
}

/*
 * The matrix-displaying function.
 */
void show_matrix(const char *name,Matrix m)
{
  int i,j;
  printf("%s (size %d by %d) =\n",name,(int)m.m,(int)m.n);
  for (i=0; i<m.m; i++)
    {
      fputs("( ",stdout);
      for (j=0; j<m.n; j++)
        printf("%12.2f",m.addr[i*m.n+j]);
      fputs(" )\n",stdout);
    }
}

[ fmat.f90 ]

Module matrix_multiply_for_c
  Use Iso_C_Binding
  Implicit None
  Type,Bind(C) :: matrix
    Type(C_ptr) :: addr
    Integer(C_size_t) :: m,n
  End Type
Contains
  Function c_matmul_r(a,b) Result(c) Bind(C,Name='Matrix_Multiply_r')
    Type(matrix),Intent(In),Value :: a,b
    Type(matrix) :: c
    Real(C_float),Pointer :: fa(:,:),fb(:,:),fc(:,:)
    !
    ! Get the input array pointers (transposed because C).
    !
    Call C_F_Pointer(a%addr,fa,[a%n,a%m])
    Call C_F_Pointer(b%addr,fb,[b%n,b%m])
    !
    ! Allocate the result.
    !
    Allocate(fc(b%n,a%m))
    !
    ! Compute the result value.
    !
    ! C arrays are stored in "row-major" format,
    ! this is the transpose of the Fortran (column-major) format;
    ! so we need to transpose both the input arrays, and the result.
    !
    fc = Transpose(Matmul(Transpose(fa),Transpose(fb)))
    !
    ! Store the result info.
    !
    c%m = a%m
    c%n = b%n
    c%addr = C_loc(fc(1,1))
  End Function
  Subroutine c_dealloc_mat(c) Bind(C,Name='Fortran_Deallocate_Matrix')
    Type(matrix),Value :: c
    Real(C_float),Pointer :: fc(:,:)
    Call C_F_Pointer(c%addr,fc,[c%n,c%m])
    Deallocate(fc)
  End Subroutine
End Module

[ 実行例 ]

A (size 3 by 4) =
(         0.00        1.00        2.00        3.00 )
(         4.00        5.00        6.00        7.00 )
(         8.00        9.00       10.00       11.00 )
B (size 4 by 5) =
(         0.00        1.00        2.00        3.00        4.00 )
(         5.00        6.00        7.00        8.00        9.00 )
(        10.00       11.00       12.00       13.00       14.00 )
(        15.00       16.00       17.00       18.00       19.00 )
Product(C) (size 3 by 5) =
(        70.00       76.00       82.00       88.00       94.00 )
(       190.00      212.00      234.00      256.00      278.00 )
(       310.00      348.00      386.00      424.00      462.00 )

19.15 C から Fortran を呼び出す例：文字列と整数型配列を Fortran に渡す

このプログラムは、次の３つのソースファイル cmain.c（メイン），util.f90，unf.f90 で構成されています。

[ cmain.c ]

#include <stdio.h>

/*
 * Fortran procedures to do Fortran unformatted file input/output,
 * with integer arrays.
 */

extern int open_unformatted(char *name);
extern void write_unformatted_integer_array(int,int *,int);
extern void read_unformatted_integer_array(int,int *,int);
extern void close_unformatted(int);

int main(int argc,char *argv[])
{
  int i,x[200],y[100],unit;

  /* Initialise Fortran Runtime System. */
  f90_init(argc,argv);

  /*
   * Store some values in an integer array.
   */
  for (i=0; i<200; i++)
    x[i] = i*10;
  /*
   * Write the integer array to an unformatted file.
   */
  unit = open_unformatted("example.dat");
  write_unformatted_integer_array(unit,x,sizeof(x)/sizeof(int));
  close_unformatted(unit);
  /*
   * Read part of the file back to check that it was written correctly.
   */
  unit = open_unformatted("example.dat");
  read_unformatted_integer_array(unit,y,sizeof(y)/sizeof(int));
  close_unformatted(unit);
  for (i=0; i<100; i++)
    if (y[i]!=x[i])
      {
        printf("Read check FAILED %d != %d\n",y[i],x[i]);
        return 2;
      }
  /*
   * Finished.
   */
  printf("Write of example.dat finished, read check ok.\n");
  return 0;
}

[ util.f90 ]

Module util
  Implicit None
Contains
  !
  ! Return a copy of a C string.
  ! The result is ALLOCATABLE so the space will be automatically
  ! recovered after the call.
  !
  Function fstring(string)
    Use Iso_C_Binding
    Character(1,C_char),Intent(In) :: string(*)
    Character(:,C_char),Allocatable :: fstring
    Integer i,len
    len = 1
    Do While (string(len)/=C_null_char)
      len = len + 1
    End Do
    len = len - 1
    Allocate(Character(len,C_char) :: fstring)
    Do i=1,len
      fstring(i:i) = string(i)
    End Do
  End Function
End Module

[ unf.f90 ]

Module unformatted_file_functions_for_C
  Use Iso_C_Binding
  Implicit None
Contains
  Function open_unformatted(cname) Bind(C) Result(unit)
    Use util
    Character(1,C_char),Intent(In) :: cname(*)
    Integer(C_int) :: unit
    Open(File=fstring(cname),Newunit=unit,Form='Unformatted', &
         Access='Sequential')
  End Function
  Subroutine close_unformatted(unit) Bind(C)
    Integer(C_int),Value :: unit
    Close(unit)
  End Subroutine
  Subroutine write_unformatted_integer_array(unit,array,n) Bind(C)
    Integer(C_int),Value :: unit,n
    Integer(C_int),Intent(In) :: array(n)
    Write(unit) array
  End Subroutine
  Subroutine read_unformatted_integer_array(unit,array,n) Bind(C)
    Integer(C_int),Value :: unit,n
    Integer(C_int),Intent(Out) :: array(n)
    Read(unit) array
  End Subroutine
End Module

[ 実行例 ]

Write of example.dat finished, read check ok.

19.16 C から Fortran を呼び出す例：文字型ポインタの配列を Fortran に渡す

このプログラムは、次の３つのソースファイル cmain.c（メイン），chptrarray.f90，display.f90 で構成されています。

[ cmain.c ]

#include <stdio.h>

/*
 * Fortran procedure to display information about the table.
 */
extern void display_table_info(char *table[]);

int main(int argc,char *argv[])
{
  static char *table[] = {
    "Entry One",
    "Entry Two",
    "Entry Three",
    "And this entry is the longest one",
    "Entry Five",
    "Another entry that is very long..",
    (char *)0
  };
  display_table_info(table);
  return 0;
}

[ chptrarray.f90 ]

!
! Utility module
!
Module util_char_ptr
  Use Iso_C_Binding
  Implicit None
  !
  ! Derived type for wrapping a character string pointer in Fortran.
  !
  Type char_string_ptr
    Character(:,C_char),Pointer :: value => Null()
  End Type
Contains
  !
  ! Utility function to convert a C array of char pointers, ending with a
  ! null pointer, into an array of character string pointers in Fortran.
  !
  Function ctable_to_ftable(cptr) Result(r)
    Type(C_ptr) :: cptr(*)
    Type(char_string_ptr),Pointer :: r(:)
    Integer i,n
    n = 1
    Do While(C_associated(cptr(n)))
      n = n + 1
    End Do
    n = n - 1
    Allocate(r(n))
    Do i=1,n
      r(i)%value => c_charptr_to_f_charptr(cptr(i))
    End Do
  End Function
  !
  ! Utility routine to turn a C pointer to a null-terminated string
  ! into a Fortran CHARACTER pointer to that string.  The function
  ! returns a deferred-length CHARACTER pointer that is associated with
  ! the C string, and whose length (LEN) is the length of the string.
  !
  Function c_charptr_to_f_charptr(ccp) Result(result)
    Type(C_ptr),Intent(In),Value :: ccp
    Character(:,C_char),Pointer :: result
    Interface
      Function strlen(p) Bind(C)
        Import C_ptr,C_size_t
        Type(C_ptr),Value :: p
        Integer(C_size_t) strlen
      End Function
    End Interface
    result => convert_cptr(ccp,strlen(ccp))
  Contains
    !
    ! This uses a variable-length CHARACTER pointer because the
    ! function C_F_pointer has no other way of encoding the length.
    !
    Function convert_cptr(p,len)
      Type(C_ptr),Intent(In) :: p
      Integer(C_size_t),Intent(In) :: len
      Character(len,C_char),Pointer :: convert_cptr
      Call C_F_pointer(p,convert_cptr)
    End Function
  End Function
End Module

[ display.f90 ]

!
! Subroutine to display the maximum string value in a table,
! and the maximum string length in that table.
!
! The table is simply a C array of C char strings (null-terminated).
!
Subroutine display_c_table(table) Bind(C,Name='display_table_info')
  Use util_char_ptr
  Implicit None
  Type(C_Ptr) table(*)
  Type(char_string_ptr),Pointer :: ftable(:)
  Integer i,maxlen,maxlenpos,maxstrpos
  !
  ! Start by constructing an array of Fortran character pointers to the table.
  !
  ftable => ctable_to_ftable(table)
  If (Size(ftable)==0) Then
    Print *,'Empty table'
  Else
    maxlen = Len(ftable(1)%value)
    maxlenpos = 1
    maxstrpos = 1
    Do i=2,Size(ftable)
      If (Len(ftable(i)%value)>maxlen) Then
        maxlen = Len(ftable(i)%value)
        maxlenpos = i
      End If
      If (ftable(i)%value>ftable(maxstrpos)%value) maxstrpos = i
    End Do
    Print *,'Maximum string value is "',ftable(maxstrpos)%value,'"'
    Print *,'Maximum string length is',maxlen
    Print *,'The first string with that length is "',ftable(maxlenpos)%value,'"'
  End If
  Deallocate(ftable)
End Subroutine

[ 実行例 ]

 Maximum string value is "Entry Two"
 Maximum string length is 33
 The first string with that length is "And this entry is the longest one"

前へ上へ次へ

Fortran Tip集

19 C との相互利用可能性の例

19.1 コンパイルとリンク

19.2 その他のキーポイント

19.3 参考文献

19.4 Fortran から C を呼び出す例： Hello World

19.5 Fortran から C を呼び出す例： 整数型スカラの変数と値を渡す

19.6 Fortran から C を呼び出す例： 整数型配列を C に渡す

19.7 Fortran から C を呼び出す例： 実数型配列を C に渡す

19.8 Fortran から C を呼び出す例： 文字型スカラを C に渡す

19.9 Fortran から C を呼び出す例： 文字型スカラのポインタを C から得る

19.10 Fortran から C を呼び出す例： C の連結リストの生成と走査

19.11 Fortran から C を呼び出す例： 高度な連結リストの例

19.12 C から Fortran を呼び出す例： Hello World

19.13 C から Fortran を呼び出す例： float 型（実数型）配列を Fortran に渡す

19.14 C から Fortran を呼び出す例： float 型（実数型）配列のポインタを Fortran に渡す

19.15 C から Fortran を呼び出す例： 文字列と整数型配列を Fortran に渡す

19.16 C から Fortran を呼び出す例： 文字型ポインタの配列を Fortran に渡す

19.5 Fortran から C を呼び出す例：整数型スカラの変数と値を渡す

19.6 Fortran から C を呼び出す例：整数型配列を C に渡す

19.7 Fortran から C を呼び出す例：実数型配列を C に渡す

19.8 Fortran から C を呼び出す例：文字型スカラを C に渡す

19.9 Fortran から C を呼び出す例：文字型スカラのポインタを C から得る

19.11 Fortran から C を呼び出す例：高度な連結リストの例

19.15 C から Fortran を呼び出す例：文字列と整数型配列を Fortran に渡す

19.16 C から Fortran を呼び出す例：文字型ポインタの配列を Fortran に渡す