This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / v / funzer.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1996/04/01 15:02:57  mclareni
6 * Mathlib gen
7 *
8 *
9 #include "gen/pilot.h"
10       SUBROUTINE FUNZER(FUNC,X2LOW,X2HIGH,XLOW,XHIGH)
11 C         FIND RANGE WHERE FUNC IS NON-ZERO.
12 C         WRITTEN 1980, F. JAMES
13 C         MODIFIED, NOV. 1985, TO FIX BUG AND GENERALIZE
14 C         TO FIND SIMPLY-CONNECTED NON-ZERO REGION (XLOW,XHIGH)
15 C         ANYWHERE WITHIN THE GIVEN REGION (X2LOW,H2HIGH).
16 C            WHERE 'ANYWHERE' MEANS EITHER AT THE LOWER OR UPPER
17 C            EDGE OF THE GIVEN REGION, OR, IF IN THE MIDDLE,
18 C            COVERING AT LEAST 1% OF THE GIVEN REGION.
19 C         OTHERWISE IT IS NOT GUARANTEED TO FIND THE NON-ZERO REGION.
20 C         IF FUNCTION EVERYWHERE ZERO, FUNZER SETS XLOW=XHIGH=0.
21       EXTERNAL FUNC
22       XLOW = X2LOW
23       XHIGH = X2HIGH
24 C         FIND OUT IF FUNCTION IS ZERO AT ONE END OR BOTH
25       XMID = XLOW
26       IF (FUNC(XLOW) .GT. 0.) GO TO 120
27       XMID = XHIGH
28       IF (FUNC(XHIGH) .GT. 0.)  GO TO 50
29 C         FUNCTION IS ZERO AT BOTH ENDS,
30 C         LOOK FOR PLACE WHERE IT IS NON-ZERO.
31       DO 30 LOGN= 1, 7
32       NSLICE = 2**LOGN
33       DO 20 I= 1, NSLICE, 2
34       XMID = XLOW + I * (XHIGH-XLOW) / NSLICE
35       IF (FUNC(XMID) .GT. 0.)  GO TO 50
36    20 CONTINUE
37    30 CONTINUE
38 C         FALLING THROUGH LOOP MEANS CANNOT FIND NON-ZERO VALUE
39       WRITE(6,554)
40       WRITE(6,555) XLOW, XHIGH
41       XLOW = 0.
42       XHIGH = 0.
43       GO TO 220
44 C
45    50 CONTINUE
46 C         DELETE 'LEADING' ZERO RANGE
47       XH = XMID
48       XL = XLOW
49       DO 70 K= 1, 20
50       XNEW = 0.5*(XH+XL)
51       IF (FUNC(XNEW) .EQ. 0.) GO TO 68
52       XH = XNEW
53       GO TO 70
54    68 XL = XNEW
55    70 CONTINUE
56       XLOW = XL
57       WRITE(6,555) X2LOW,XLOW
58   120 CONTINUE
59       IF (FUNC(XHIGH) .GT. 0.) GO TO 220
60 C         DELETE 'TRAILING' RANGE OF ZEROES
61       XL = XMID
62       XH = XHIGH
63       DO 170 K= 1, 20
64       XNEW = 0.5*(XH+XL)
65       IF (FUNC(XNEW) .EQ. 0.) GO TO 168
66       XL = XNEW
67       GO TO 170
68   168 XH = XNEW
69   170 CONTINUE
70       XHIGH = XH
71       WRITE(6,555) XHIGH, X2HIGH
72 C
73   220 CONTINUE
74       RETURN
75   554 FORMAT('0CANNOT FIND NON-ZERO FUNCTION VALUE')
76   555 FORMAT(' FUNCTION IS ZERO FROM X=',E12.5,' TO ',E12.5)
77       END