How to convert a C-utility into a subroutine and call it from gfortran?

[Paul Richard Thomas]

Arjan,

Just to add to Tobias' perfectly correct replies, I have attached an
example that illustrates passing a pointer to the data "F77 style" or
passing an array descriptor and using an extract from libgfortran.h

Compile using #my_gfortran f_to_c.f90 my_c.c -o f_t_c

The code that you get for the main program is:

MAIN__ ()
{
  int4 i;
  static real4 a[10] = {1.0e+0, 2.0e+0, 3.0e+0, 4.0e+0, 5.0e+0, 6.0e+0, 7.0e+0,
8.0e+0, 9.0e+0, 1.0e+1};

  _gfortran_set_std (68, 127, 0, 0, 0);
  myc1 (&a);
  {
    struct array1_real4 parm.0;

    parm.0.dtype = 281;
    parm.0.dim[0].lbound = 1;
    parm.0.dim[0].ubound = 10;
    parm.0.dim[0].stride = 1;
    parm.0.data = (void *) &a[0];
    parm.0.offset = -1;
    myc2 (&parm.0);
  }
  {
    struct array1_real4 parm.1;

    parm.1.dtype = 281;
    parm.1.dim[0].lbound = 1;
    parm.1.dim[0].ubound = 4;
    parm.1.dim[0].stride = 1;
    parm.1.data = (void *) &a[1];
    parm.1.offset = -2;
    myc2 (&parm.1);
  }
  {
    char A.4[2][1:8];
    struct array1_unknown atmp.3;
    static char[1:8] * A.2[2] = {"string 1", "string 2"};

    atmp.3.dtype = 561;
    atmp.3.dim[0].stride = 1;
    atmp.3.dim[0].lbound = 0;
    atmp.3.dim[0].ubound = 1;
    atmp.3.data = (void *) &A.4;
    atmp.3.offset = 0;
    {
      int4 S.5;

      S.5 = 0;
      while (1)
        {
          if (S.5 > 1) goto L.1;
          (*(char[0:][1:8] *) atmp.3.data)[S.5] = *A.2[S.5];
          S.5 = S.5 + 1;
        }
      L.1:;
    }
    myc3 (&atmp.3, 8);
  }
}

where you can see how myc1 and myc2/myc3 are called differently.  In
the case of myc2, for example, the descriptors parm.0 and parm.1 are
written and passed to the subroutine.  The f77 style of call simply
passes the data pointer.

Cheers

Paul

-- 
I love deadlines. I love the whooshing sound they make as they go by.
--Douglas Adams
-------------- next part --------------

      program myprog
      external   myc1
      interface
        subroutine myc2 (x)
          real(4) :: x(:)
        end subroutine
      end interface
      interface
        subroutine myc3 (c)
          character(*) :: c(:)
        end subroutine
      end interface

      real :: a(10) = (/(real (i), i = 1, 10)/)

      call  myc1 (a)

      call  myc2 (a)

      call  myc2 (a(2:5))

      call  myc3 ((/"string 1", "string 2"/))

      end

-------------- next part --------------
#include <stdio.h>

/************************Borrow from libgfortran.h  **********************/
#ifndef GFC_MAX_DIMENSIONS
#define GFC_MAX_DIMENSIONS 7
#endif
typedef ssize_t index_type;

typedef struct descriptor_dimension
{
  index_type stride;
  index_type lbound;
  index_type ubound;
}
descriptor_dimension;

#define GFC_ARRAY_DESCRIPTOR(r, type) \
struct {\
  type *data;\
  size_t offset;\
  index_type dtype;\
  descriptor_dimension dim[r];\
}

typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, float) gfc_array_r4;
typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, char) gfc_array_char;

#define GFC_DTYPE_RANK_MASK 0x07
#define GFC_DTYPE_TYPE_SHIFT 3
#define GFC_DTYPE_TYPE_MASK 0x38
#define GFC_DTYPE_SIZE_SHIFT 6

enum
{
  GFC_DTYPE_UNKNOWN = 0,
  GFC_DTYPE_INTEGER,
  /* TODO: recognize logical types.  */
  GFC_DTYPE_LOGICAL,
  GFC_DTYPE_REAL,
  GFC_DTYPE_COMPLEX,
  GFC_DTYPE_DERIVED,
  GFC_DTYPE_CHARACTER
};

#define GFC_DESCRIPTOR_RANK(desc) ((desc)->dtype & GFC_DTYPE_RANK_MASK)
#define GFC_DESCRIPTOR_TYPE(desc) (((desc)->dtype & GFC_DTYPE_TYPE_MASK) \
                                   >> GFC_DTYPE_TYPE_SHIFT)
#define GFC_DESCRIPTOR_SIZE(desc) ((desc)->dtype >> GFC_DTYPE_SIZE_SHIFT)
#define GFC_DESCRIPTOR_DATA(desc) ((desc)->data)
#define GFC_DESCRIPTOR_DTYPE(desc) ((desc)->dtype)
/*************************************************************************/


extern void myc1_ (float*);
extern void myc2_ (gfc_array_r4 *);
extern void myc3_ (gfc_array_char *, int);

void
myc1_(float *a)
{
  printf ("myc1\n");
  printf ("a(1) = %f a(10) = %f\n\n", a[0], a[9]);
  return;
}

void
myc2_(gfc_array_r4 *a)
{
  int i, ndim;
  ndim = GFC_DESCRIPTOR_RANK(a);
  if ((ndim != 1) || (GFC_DESCRIPTOR_TYPE(a) != GFC_DTYPE_REAL))
    {
      printf ("eeek\n");
      return;
    }
  printf ("myc2\n");
  for (i = a->dim[0].lbound; i <= a->dim[0].ubound; i++)
    printf ("a(%i) = %f\n", i, GFC_DESCRIPTOR_DATA(a)[i - a->dim[0].lbound]);
  return;
}

void
myc3_(gfc_array_char *c, int clen)
{
  int i, ndim;
  ndim = GFC_DESCRIPTOR_RANK(c);
  if ((ndim != 1) || (GFC_DESCRIPTOR_TYPE(c) != GFC_DTYPE_CHARACTER))
    {
      printf ("eeek\n");
      return;
    }
  printf ("myc3\n c(0) = ");
  for (i = 0; i < clen; i++)
    printf ("%c", GFC_DESCRIPTOR_DATA(c)[i]);

  printf ("\n c(1) = ");
  for (i = 0; i < clen; i++)
    printf ("%c", GFC_DESCRIPTOR_DATA(c)[i + clen]);
  printf ("\n");
  return;
}