1C*PGFUNX -- function defined by Y = F(X)
2C+
3      SUBROUTINE PGFUNX (FY, N, XMIN, XMAX, PGFLAG)
4      REAL FY
5      EXTERNAL FY
6      INTEGER N
7      REAL XMIN, XMAX
8      INTEGER PGFLAG
9C
10C Draw a curve defined by the equation Y = FY(X), where FY is a
11C user-supplied subroutine.
12C
13C Arguments:
14C  FY     (external real function): supplied by the user, evaluates
15C                    Y value at a given X-coordinate.
16C  N      (input)  : the number of points required to define the
17C                    curve. The function FY will be called N+1 times.
18C                    If PGFLAG=0 and N is greater than 1000, 1000
19C                    will be used instead.  If N is less than 1,
20C                    nothing will be drawn.
21C  XMIN   (input)  : the minimum value of X.
22C  XMAX   (input)  : the maximum value of X.
23C  PGFLAG (input)  : if PGFLAG = 1, the curve is plotted in the
24C                    current window and viewport; if PGFLAG = 0,
25C                    PGENV is called automatically by PGFUNX to
26C                    start a new plot with X limits (XMIN, XMAX)
27C                    and automatic scaling in Y.
28C
29C Note: The function FY must be declared EXTERNAL in the Fortran
30C program unit that calls PGFUNX.  It has one argument, the
31C x-coordinate at which the y value is required, e.g.
32C   REAL FUNCTION FY(X)
33C   REAL X
34C   FY = .....
35C   END
36C--
37C  6-Oct-1983 - TJP.
38C  6-May-1985 - fix Y(0) bug - TJP.
39C 11-May-1990 - remove unnecessary include - TJP.
40C-----------------------------------------------------------------------
41      INTEGER MAXP
42      PARAMETER (MAXP=1000)
43      INTEGER  I, NN
44      REAL     Y(0:MAXP), DT, DY
45      REAL     YMIN, YMAX
46C
47C Check N > 1, and find parameter increment.
48C
49      IF (N.LT.1) RETURN
50      DT = (XMAX-XMIN)/N
51      CALL PGBBUF
52C
53C Case 1: we do not have to find limits.
54C
55      IF (PGFLAG.NE.0) THEN
56          CALL PGMOVE(XMIN,FY(XMIN))
57          DO 10 I=1,N
58              CALL PGDRAW(XMIN+I*DT,FY(XMIN+I*DT))
59   10     CONTINUE
60C
61C Case 2: find limits and scale plot; function values must be stored
62C in an array.
63C
64      ELSE
65          NN = MIN(N,MAXP)
66          Y(0) = FY(XMIN)
67          YMIN = Y(0)
68          YMAX = Y(0)
69          DO 20 I=1,NN
70              Y(I) = FY(XMIN+DT*I)
71              YMIN = MIN(YMIN,Y(I))
72              YMAX = MAX(YMAX,Y(I))
73   20     CONTINUE
74          DY = 0.05*(YMAX-YMIN)
75          IF (DY.EQ.0.0) THEN
76              YMIN = YMIN - 1.0
77              YMAX = YMAX + 1.0
78          ELSE
79              YMIN = YMIN - DY
80              YMAX = YMAX + DY
81          END IF
82          CALL PGENV(XMIN,XMAX,YMIN,YMAX,0,0)
83          CALL PGMOVE(XMIN,Y(0))
84          DO 30 I=1,NN
85              CALL PGDRAW(XMIN+DT*I,Y(I))
86   30     CONTINUE
87      END IF
88C
89      CALL PGEBUF
90      END
91