delorie.com/archives/browse.cgi   search  
Mail Archives: djgpp/1997/07/23/05:32:19

From: mstucky AT tiac DOT net (Mark B. Stucky)
Newsgroups: comp.os.msdos.djgpp
Subject: Re: Calling Fortran subroutines?
Date: Tue, 22 Jul 1997 23:26:41 GMT
Organization: The Internet Access Company, Inc.
Lines: 271
Message-ID: <33d53e65.522258399@news.tiac.net>
References: <33CFABEE DOT DAEBDD9D AT tamu DOT edu> <5r1rsr$j7l$1 AT salomon DOT mchp DOT siemens DOT de>
NNTP-Posting-Host: mstucky.tiac.net
To: djgpp AT delorie DOT com
DJ-Gateway: from newsgroup comp.os.msdos.djgpp

On 22 Jul 1997 08:44:11 GMT, martin DOT kahlert AT mchp DOT siemens DOT de (Martin
Kahlert) wrote:

>[Posted and mailed]
>
>In article <33CFABEE DOT DAEBDD9D AT tamu DOT edu>,
>	"John M. Wildenthal" <j-wildenthal AT tamu DOT edu> writes:
>> I am trying to see if I must use F2C on Fortran77 code, or can I just
>> compile it (using G77) and treat it as just another set of object code?
>> 
>You can just compile with g77.

What Martin said below applies to f2c as well.  That's what I use with
djgpp.

>> I have been told that C and Fortran pass arguments in different order
>> (LIFO vs FIFO), but I was wondering if arrays were passed by address
>> (like C) or value.
>Fortran passes ALL values by reference. (except...)
>If you have a Fortran routine
>
>      SUBROUTINE FOO(A,B,C,D,E)
>      IMPLICIT NONE
>      INTEGER*4 A,B(10)
>      REAL*8 C
>      REAL D
>      INTEGER*2 E
>      INTEGER*4 I
>      
>      DO I=1, 10
>         B(I)=I
>      ENDDO
>C     DO SOMETHING WITH THEM...
>      RETURN 
>      END
>
>in C you have to do something like
>
>extern void foo_(int *a,int *b,double *c,float *d,short *e);
>
>int main()
>{
> int a,b[10];
> double c;
> float d;
> short e;
>
> foo_(&a,b,&c,&d,&e);
> return 0;
>}
>
>That's the way it works in LINUX, perhaps you have 
>to leave out the underscores under djgpp.
>So:
>- all parameters are put by reference!
>- Though the array B has to be accessed by B(1),...,B(10)
>  in Fortran, you pass &b[0] from C.
>- in Fortran, the innermost indizes of multidim arrays run
>  fastest - different to C. So if you want to pass a
>  Matrix MAT(2,2): MAT(1,1)=11,MAT(1,2)=12, MAT(2,1)=21, MAT(22)=22
>  to Fortran, you have to initialize a 1D array 
>  mat[0]=11, mat[1]=21, mat[2]=12, mat[3]=22 from C.
>- You should try to avoid passing CHARACTER variables to FORTRAN.
>  I  t h i n k   they are passed in the following way:
>  SUBROUTINE FOO(A,B,C)
>  INTEGER*4 A
>  CHARACTER*8 B,C
>  RETURN 
>  END
>
>  is aequivalent to: 
>  FOO(int a, char *b,long lenght_of_b,long lenght_of_c)
>                        ^^^                ^^^
>                                 no *!
>  with length=8.
>  there is no 0-Byte at the end of the Fortran string.
>  All this is very compiler dependent, so avoid characters.
>
>Hope this helps.
>Martin.



You don't have to avoid CHARACTER variables, you just need to pass
them in the form that the other language expects.  Here is an example
of a routine that I use with f2c to get the current directory from a
Fortran routine.  Hopefully it is fairly easy to figure out what I'm
doing, if not let me know.  I'm doing a little creative cutting and
pasting here, let's hope I don't screw it up to much... :)

If you have more questions, let me know...

--Mark
  mstucky AT tiac DOT net

First a wrapper routine that is called from the Fortran code...

      subroutine getcwd(buf, imax)

      integer*4 imax
      character*(*) buf
      character*255 tbuf

      call strf2c(buf, tbuf, LEN(buf))
      call mygetcwd(tbuf, imax)
      call strc2f(tbuf, buf)

      return
      end

Now a couple of utility routines

      subroutine strf2c(string1, string2, maxlen)

      integer*4 maxlen
      character*(*) string1, string2

      integer*4 limit, mystrlen
      external mystrlen

      limit = min0(mystrlen(string1),maxlen-1)
      do 100 i = 1,limit
         string2(i:i) = string1(i:i) 
 100  continue
      string2(limit+1:limit+1) = char(0)

      return
      end


      subroutine strc2f(string1, string2)

      character*(*) string1, string2

      integer*4 limit
      character*300 stringbuf

      limit = 1
 10   if (ichar(string1(limit:limit)) .eq. 0) goto 20
      stringbuf(limit:limit) = string1(limit:limit)
      limit = limit + 1
      if (limit .GT. 300 .OR. limit .GT. LEN(string2) ) goto 20
      goto 10
	
 20   continue
      if ( limit .GT. 1 ) then
         string2 = stringbuf(1:limit-1)
      else
         string2 = ' '
      endif

      return
      end


      integer function mystrlen(string)
      character*(*) string
      integer i

      do 100 i = len(string),1,-1
         if (string(i:i) .ne. ' ') then
            mystrlen = i
            return
         endif
 100  continue
	   
      mystrlen = 1
      return
      end



A finally the C routine...

ifdef UNIX
# define USE_GETCWD
# ifdef TITAN
#  include <limits.h>
   typedef long  clock_t;
   typedef struct {
     unsigned char *data;
     int length;
   } F77STRING ;
# endif
# ifdef AIX
#  include <unistd.h>
#  undef USE_GETCWD
#endif
#endif


#ifndef TITAN
#  define F77STRING char
#endif

#undef FORTRAN_STUBS_DEFINED

#ifdef TITAN
# define FORTRAN_UC
# undef  FORTRAN_AU
# define FORTRAN_STUBS_DEFINED
#endif

#ifdef AMIGA
# define FORTRAN_LC
# define FORTRAN_AU
# define FORTRAN_STUBS_DEFINED
#endif

#ifdef MSDOS
# define FORTRAN_LC
# define FORTRAN_AU
# define FORTRAN_STUBS_DEFINED
#endif

#ifdef _AIX
# define FORTRAN_LC
# undef  FORTRAN_AU
# define FORTRAN_STUBS_DEFINED
#endif

#ifndef FORTRAN_STUBS_DEFINED
# define FORTRAN_LC
# define FORTRAN_AU
#endif

#ifdef FORTRAN_LC                 /* Lower case */

# ifdef FORTRAN_AU                /* Append underscore */
#  define C_MYGETCWD  mygetcwd_
# else
#  define C_MYGETCWD  mygetcwd
# endif

#else

# ifdef FORTRAN_AU                /* Append underscore */
#  define C_MYGETCWD  MYGETCWD_
# else
#  define C_MYGETCWD  MYGETCWD
# endif

#endif



int C_MYGETCWD(F77STRING *buffer, int *max)
{
   char *buf;


#ifdef USE_GETCWD
   buf = (char *) getcwd((char *)NULL, *max);
#else
   buf = (char *) getwd(buffer);
#endif

#ifndef TITAN
   strcpy(buffer, buf);
#else
   strcpy(buffer->data, buf);
   buffer->length = strlen(buf);
#endif

/***
  ?? is this necessary...
   if (buffer == NULL) free(buf);
***/
}


- Raw text -


  webmaster     delorie software   privacy  
  Copyright © 2019   by DJ Delorie     Updated Jul 2019