Path: utzoo!utgpu!news-server.csri.toronto.edu!rpi!zaphod.mps.ohio-state.edu!caen!news.cs.indiana.edu!noose.ecn.purdue.edu!dirac!maxwell.physics.purdue.edu
From: piner@maxwell.physics.purdue.edu (Richard Piner)
Newsgroups: comp.lang.fortran
Subject: f2c bug
Message-ID: <4846@dirac.physics.purdue.edu>
Date: 5 Apr 91 10:40:33 GMT
Sender: news@dirac.physics.purdue.edu
Organization: Purdue University Physics Department, W. Lafayette, IN
Lines: 122

Looks like I have found a little bug in f2c. Of course, it took a
routine from NR to break it. Here it is. Always double check code
before using it.

      SUBROUTINE QUAD3D(X1,X2,SS)
c you will need to add an explicit declaration of real here.
c      real H
      EXTERNAL H
      CALL QGAUSX(H,X1,X2,SS)
      RETURN
      END
C     
      FUNCTION F(ZZ)
      EXTERNAL FUNC
      COMMON /XYZ/ X,Y,Z
      Z=ZZ
      F=FUNC(X,Y,Z)
      RETURN
      END
C     
      FUNCTION G(YY)
      EXTERNAL Z1,Z2,F
      COMMON /XYZ/ X,Y,Z
      Y=YY
      CALL QGAUSZ(F,Z1(X,Y),Z2(X,Y),SS)
      G=SS
      RETURN
      END
C     
      FUNCTION H(XX)
      EXTERNAL Y1,Y2,G
      COMMON /XYZ/ X,Y,Z
      X=XX
      CALL QGAUSY(G,Y1(X),Y2(X),SS)
      H=SS
      RETURN
      END
------------------------------
f2c puts out the following code:
------------------------------
/* quad3d.f -- translated by f2c (version of 7 December 1990  17:37:08).
   You must link the resulting object file with the libraries:
	-lF77 -lI77 -lm -lc   (in that order)
*/

#include "/c/optics/F2c/f2c.h"

/* Common Block Declarations */

struct {
    real x, y, z;
} xyz_;

#define xyz_1 xyz_

/* Subroutine */ int quad3d_(x1, x2, ss)
real *x1, *x2, *ss;
{
/* h_() should be declared real !!!!! */
    extern /* Subroutine */ int h_();
    extern /* Subroutine */ int qgausx_();

/*      real H */
    qgausx_(h_, x1, x2, ss);
    return 0;
} /* quad3d_ */


doublereal f_(zz)
real *zz;
{
    /* System generated locals */
    real ret_val;

    /* Local variables */
    extern doublereal func_();

    xyz_1.z = *zz;
    ret_val = func_(&xyz_1.x, &xyz_1.y, &xyz_1.z);
    return ret_val;
} /* f_ */


doublereal g_(yy)
real *yy;
{
    /* System generated locals */
    real ret_val, r__1, r__2;

    /* Local variables */
    extern doublereal f_(), z1_(), z2_();
    static real ss;
    extern /* Subroutine */ int qgausz_();

    xyz_1.y = *yy;
    r__1 = z1_(&xyz_1.x, &xyz_1.y);
    r__2 = z2_(&xyz_1.x, &xyz_1.y);
    qgausz_(f_, &r__1, &r__2, &ss);
    ret_val = ss;
    return ret_val;
} /* g_ */


doublereal h_(xx)
real *xx;
{
    /* System generated locals */
    real ret_val, r__1, r__2;

    /* Local variables */
    extern doublereal g_(), y1_(), y2_();
    static real ss;
    extern /* Subroutine */ int qgausy_();

    xyz_1.x = *xx;
    r__1 = y1_(&xyz_1.x);
    r__2 = y2_(&xyz_1.x);
    qgausy_(g_, &r__1, &r__2, &ss);
    ret_val = ss;
    return ret_val;
} /* h_ */