Path: utzoo!attcan!uunet!ogicse!mintaka!bloom-beacon!athena.mit.edu!mlzerkle
From: mlzerkle@athena.mit.edu (Michael L Zerkle)
Newsgroups: comp.lang.fortran
Subject: FORTRAN callable C functions to allocate/deallocate arrays.
Message-ID: <1990Nov9.210442.27086@athena.mit.edu>
Date: 9 Nov 90 21:04:42 GMT
Sender: daemon@athena.mit.edu (Mr Background)
Reply-To: mlzerkle@athena.mit.edu (Michael L Zerkle)
Organization: Massachusetts Institute of Technology
Lines: 99

I am trying to develop C functions to allocate and deallocate arrays
for use in a FORTRAN progam that would run on a number of different
UNIX boxes (DEC VS3100, Apollo, SGI 4D/210, etc.).  The C functions
I have written appear to allocate the double array correctly, but
either it does not pass it back the the FORTRAN program correctly, or
the FORTRAN program is not accepting the pointer/array it is returning.

Does anyone out there have any experience with problems of this sort,
or know what I am doing wrong?  Any suggestions?

Basic info:
  	f77 compiler on SGI 4D/210
        ANSI C compiler on SGI 4D/210
	same problem on other UNIX systems.

Thanks in advance for any help.

Mike Zerkle
mlzerkle@athena.mit.edu

********************
* Fortran Code ... *
********************

      program testgetm
      real*8 a(1)
      integer*4 maxa,bytesa,i
      external getmd,freemd
c
      maxa=5
      bytesa=8
c
c Write Initial location.
c
      write(6,'(a)') 'Initial address'
      write(6,*) loc(a),maxa,bytesa
c
c Allocate real*8 array.
c
       call getmd(a,maxa)
c
c Write addresses
c
      write(6,'(a)') 'Final address'
      write(6,*) loc(a),maxa,bytesa
c
c Work on array
c
      write(6,'(a)') 'REAL*8 array '
      if (loc(a).ne.0) then
       	 do 10 i=1,maxa
c           a(i)= 1.0d+0*i
	    write(6,*) i, a(i)
 10      continue
      else
	 write(6,'(a)') ' Unable to allocate r*8 array a'
      endif
c
c Free arrays.
c
      if (loc(a).ne.0) call freemd(a)
c
      stop
      end

**************
* C Code ... *
**************

#include <stdlib.h>

void getmd_(double *array, int *nelem)
{
  printf("org array addr = %ld\n",array);
  array = (double *) calloc((size_t) *nelem, (size_t) sizeof(double));
  printf("new array addr = %ld\n",array);
}

void freemd_(double *array)
{
  free((void *) array);
}

*********************
* Sample output ... *
*********************

Initial address
  29996  5  8
org array addr = 29996
new array addr = 54272
Final address
  29996  5  8
REAL*8 array 
  1  0.
  2  0.
  3  0.
  4   1.1840974637956d+30
  5   5.2810833895564d-20