help on interfacing with fortran

["Paolo M. Pumilia" <chaos@cstc.org>]

[-- Attachment #1: Type: text/plain, Size: 1714 bytes --]

I would like to interface a set of fortran soubroutines and functions
to main Ada procedure.
Here are enclosed three functions and a subroutine which i am working
on, at present. They are all stored in a single file, that i used to
compile and link to its fortran main code.

The Ada procedure makes one call to the subroutine start_carry(idum),
getting an integer number (idum) in return

Then the function rnor(idum) will be called, returnig a real*8 random
number.

How to perform such calls?

I took a look at tha ARM, but its contents appears rather cryptic to me.

I have been reading a few introductive manuals (Lovelace, Dodrill-tutor,
etc)
but they don't cover this topic very well.
Interfacing is completely new in my experience. Could those four fortran

codes be kept within a single file or should they be included into an
Ada package or procedure?
A procedure for each function or subroutine should be prepared? How do
calls
between fortran functions (not involving Ada code) will be performed?

Here is my guess applied to Ada_Main procedure:

 with Interfaces.Fortran;
 use Interfaces.Fortran;
 procedure Ada_Main;

 dummy : integer
 function rnor(dum : integer)  : return float;
 pragma Convention (Fortran, dummy);
 pragma Convention (Fortran, dum);

 procedure start_carry (dummy : in out integer) is
   pragma Import (Fortran, start_carry);
   ... fortran code ? .......

 function rnor(dum : integer)  : return float is
   pragma Import (Fortran, rnor);
   ... fortran code ? .......


 begin Ada_Main
 ....
 start_carry(dummy);

 a := rnor(dum);  -- supposing a is a float variable

 ....
 end Ada_Main ;


Any suggestions and examples are welcome

thank you  for your help

Paolo Pumilia




[-- Attachment #2: rnor.f --]
[-- Type: text/plain, Size: 2619 bytes --]

      subroutine start_carry(idum)
      idum=-10231
      do iloop=1,1000
         j=icarry(idum)
      enddo
      return
      end

      function icarry(idum)
      implicit real*8(a-h,q-z)
      parameter (ib=2**24,b=1.d0/ib)
      integer*4 xn(-29:30)
      if(idum.le.0)then
         if(idum.eq.0)idum=13
         do i=1,30
            xn(i)=mod(iabs(idum)*i,37)
            xn(i-30)=xn(i)
         enddo
         ic=0
         idum=30
      endif  
      i1=idum-24
      i2=idum-10
      idn=xn(i2)-xn(i1)-ic
      if(idn.lt.0)then
         idn=idn+ib
         ic=1
        else
         ic=0
      endif
      idum=idum+1
      if(idum.gt.30)idum=1
      xn(idum)=idn
      xn(idum-30)=idn
      icarry=idn
      return
      end


      function rcarry(idum)
      implicit real*8(a-h,q-z)
      parameter (ib=2**24,b=1.d0/ib)
      rcarry=b*icarry(idum)
      return
      end
C
C MARSAGLIA,G. & TSANG,W.W. ,SIAM J.SCIE. & STAT.COMP.,5,349(1984)
C
      FUNCTION RNOR(SEED)
      IMPLICIT REAL*8(A-H,M,Q-Z)
      ! pol 29.jun.1997 	?? real*8 pc
      INTEGER*4 SEED
      parameter (i23=2**23,rmax=1.d0/i23)
      DIMENSION V(65)
      DATA   V  /.3409450d0,.4573146d0,.5397792d0,.6062427d0,.6631690d0,
     1.7136974d0,.7596124d0,.8020356d0,.8417227d0,.8792102d0,.9148948d0,
     2.9490791d0,.9820005d0,1.013848d0,1.044780d0,1.074924d0,1.104391d0,
     31.133273d0,1.161653d0,1.189601d0,1.217181d0,1.244452d0,1.271463d0,
     41.298265d0,1.324901d0,1.351412d0,1.377839d0,1.404221d0,1.430593d0,
     51.456991d0,1.483452d0,1.510012d0,1.536706d0,1.563571d0,1.590645d0,
     61.617968d0,1.645579d0,1.673525d0,1.701850d0,1.730604d0,1.759842d0,
     71.789622d0,1.820009d0,1.851076d0,1.882904d0,1.915583d0,1.949216d0,
     81.983924d0,2.019842d0,2.057135d0,2.095992d0,2.136644d0,2.179371d0,
     92.224517d0,2.272518d0,2.323934d0,2.379500d0,2.440222d0,2.507511d0,
     +2.583466d0,2.671391d0,2.776994d0,2.776994d0,2.776994d0,2.776994d0/
      DATA AA,B,C/12.37586d0,.4878992d0,12.67706d0/  
     1     C1,C2,PC,XN/.9689279d0,1.301198d0,.1958303d-1,2.776994d0/
      I=icarry(seed)-i23
      J=MOD(IABS(I),64)+1
      RNOR=I*RMAX*V(J+1)
      IF(DABS(RNOR).LE.V(J))RETURN
C
      X=(DABS(RNOR)-V(J))/(V(J+1)-V(J))
      Y=rcarry(seed)
      S=X+Y
      IF(S.GT.C2)GOTO 11
      IF(S.LE.C1)RETURN
      IF(Y.GT.C-AA*DEXP(-.5D0*(B-B*X)**2))GOTO 11
      IF(DEXP(-.5D0*V(J+1)**2)+Y*PC/V(J+1).LE.DEXP(-.5D0*RNOR**2))RETURN
C
 22      X=.3601016D0*DLOG(rcarry(seed))
         IF(-2.D0*DLOG(rcarry(seed)).LE.X**2)GOTO 22
         RNOR=DSIGN(XN-X,RNOR)
      RETURN
 11   RNOR=DSIGN(B-B*X,RNOR)
      RETURN
      END