＜BIND Example Program 1＞

!
! Demonstrates declaring and invoking a C procedure from Fortran.
!
Program bind_example_1
  Use Iso_C_Binding,Only:C_double
  Interface
    !
    ! This is for hypot from "libm".
    !
    Function hypotenuse(x,y) Bind(C,Name='hypot')
      Use Iso_C_Binding
      Real(C_double),Value :: x,y
      Real(C_double) :: hypotenuse
    End Function
  End Interface
  Print 1,0.3d0,0.4d0,hypotenuse(0.3_C_double,0.4_C_double)
1 Format(1X,'Hypotenuse for ',F0.2,',',F0.2,' is ',F0.2)
End

---

■ Execution Results

 Hypotenuse for .30,.40 is .50

＜BIND Example Program 2＞

! "ex2_fprog.f90"
! Demonstrates defining a procedure to be invoked from C.
!
! Fortran part.
!
Subroutine real_cshift_for_c(a,n,shift) Bind(C,Name='cshiftf')
  Use Iso_C_Binding
  Intrinsic Cshift
  Integer(C_int),Value :: n,shift
  Real(C_float),Intent(InOut) :: a(n)
  a = cshift(a,shift)
End Subroutine

/* "ex2_cprog.c"
 *
 * C part.
 */
#include <stdio.h>
extern void cshiftf(float *a,int n,int shift);

main()
{
  int i;
  float x[5] = { 1,2,3,4,5 };
  cshiftf(x,5,2);
  for (i=0; i<5; i++) printf(" %5.2f",x[i]);
  putc('\n',stdout);
  return 0;
}

■ Execution Results

 3.00  4.00  5.00  1.00  2.00

＜BIND Example Program 3＞

! "ex3_fprog.f90"
! Demonstrates BIND attribute on a variable.
! Also uses BIND attribute on procedures.
!
! Fortran part.
!
Module c_global_variables
  Use Iso_C_Binding
  Integer(C_long),Bind(C,Name='var1') :: x = 37_C_long
  Integer(C_short),Bind(C) :: y,z
  Interface
    Subroutine c_routine() Bind(C)
    End Subroutine
  End Interface
End Module
Program bind_example_3
  Use c_global_variables
  Call c_routine
  Print *,x,y,z
End Program

/* "ex3_cprog.c"
 *
 * C part.
 */
extern long var1;
short y = 10, z = 0;

void c_routine(void)
{
  z = var1 + 1;
}

■ Execution Results

 37 10 38

＜BIND Example Program 3＞

! "ex4_fprog.f90"
! Demonstrates BIND attribute on a derived type,
! Also uses BIND attribute on procedures.
!
! Fortran part.
!
Module c_struct_defn
  Use Iso_C_Binding
  Type,Bind(C) :: mystruct
    Real(C_float) :: x,y
    Integer(C_int) :: flags(100,200)
    Type(C_ptr) :: name  ! This is actually a char *.
    Type(C_ptr) :: z     ! This is actually a float *.
    Type(C_funptr) :: callback
  End Type
  Interface
    Subroutine init_mystruct(newvar) Bind(C)
      Import mystruct
      Type(mystruct),Intent(Out) :: newvar
    End Subroutine
    Subroutine process_mystruct(var) Bind(C)
      Import mystruct
      Type(mystruct),Value :: var
    End Subroutine
  End Interface
End Module
Program bind_example_4
  Use c_struct_defn
  Type(mystruct) x
  Call init_mystruct(x)
  x%x = 100
  x%y = 140
  Call process_mystruct(x)
End Program

/* "ex4_cprog.c"
 *
 * C part.
 */
#include <stdio.h>

struct mystruct {
  float x,y;
  int flags[200][100];
  char *name;
  float *z;
  void (*callback)(struct mystruct *);
};

void print_my_name(struct mystruct *object)
{
  fputs(object->name,stdout);
}

void init_mystruct(struct mystruct *newvar)
{
  int i,j;
  newvar->x = 0;
  newvar->y = 0;
  for (i=0; i<200; i++) for (j=0; j<100; j++) newvar->flags[i][j] = 0;
  newvar->name = "No name yet";
  newvar->z = (float *)0;
  newvar->callback = &print_my_name;
}

void process_mystruct(struct mystruct var)
{
  int i,j;
  printf("mystruct processing: %f, %f\n",var.x,var.y);
  for (i=0; i<200; i++) for (j=0; j<100; j++) if (var.flags[i][j])
    printf("  flags[%d][%d]==0x%x\n",i,j,var.flags[i][j]);
  if (var.callback) var.callback(&var);
}

■ Execution Results

 mystruct processing: 100.000000, 140.000000
 No name yet