[u/mrichter/AliRoot.git] / PHOS / shaker / funzer.f

      SUBROUTINE FUNZER(FUNC,X2LOW,X2HIGH,XLOW,XHIGH)
C         FIND RANGE WHERE FUNC IS NON-ZERO.
C         WRITTEN 1980, F. JAMES
C         MODIFIED, NOV. 1985, TO FIX BUG AND GENERALIZE
C         TO FIND SIMPLY-CONNECTED NON-ZERO REGION (XLOW,XHIGH)
C         ANYWHERE WITHIN THE GIVEN REGION (X2LOW,H2HIGH).
C            WHERE 'ANYWHERE' MEANS EITHER AT THE LOWER OR UPPER
C            EDGE OF THE GIVEN REGION, OR, IF IN THE MIDDLE,
C            COVERING AT LEAST 1% OF THE GIVEN REGION.
C         OTHERWISE IT IS NOT GUARANTEED TO FIND THE NON-ZERO REGION.
C         IF FUNCTION EVERYWHERE ZERO, FUNZER SETS XLOW=XHIGH=0.
      EXTERNAL FUNC
      XLOW = X2LOW
      XHIGH = X2HIGH
C         FIND OUT IF FUNCTION IS ZERO AT ONE END OR BOTH
      XMID = XLOW
      IF (FUNC(XLOW) .GT. 0.) GO TO 120
      XMID = XHIGH
      IF (FUNC(XHIGH) .GT. 0.)  GO TO 50
C         FUNCTION IS ZERO AT BOTH ENDS,
C         LOOK FOR PLACE WHERE IT IS NON-ZERO.
      DO 30 LOGN= 1, 7
      NSLICE = 2**LOGN
      DO 20 I= 1, NSLICE, 2
      XMID = XLOW + I * (XHIGH-XLOW) / NSLICE
      IF (FUNC(XMID) .GT. 0.)  GO TO 50
   20 CONTINUE
   30 CONTINUE
C         FALLING THROUGH LOOP MEANS CANNOT FIND NON-ZERO VALUE
      WRITE(6,554)
      WRITE(6,555) XLOW, XHIGH
      XLOW = 0.
      XHIGH = 0.
      GO TO 220
C
   50 CONTINUE
C         DELETE 'LEADING' ZERO RANGE
      XH = XMID
      XL = XLOW
      DO 70 K= 1, 20
      XNEW = 0.5*(XH+XL)
      IF (FUNC(XNEW) .EQ. 0.) GO TO 68
      XH = XNEW
      GO TO 70
   68 XL = XNEW
   70 CONTINUE
      XLOW = XL
      WRITE(6,555) X2LOW,XLOW
  120 CONTINUE
      IF (FUNC(XHIGH) .GT. 0.) GO TO 220
C         DELETE 'TRAILING' RANGE OF ZEROES
      XL = XMID
      XH = XHIGH
      DO 170 K= 1, 20
      XNEW = 0.5*(XH+XL)
      IF (FUNC(XNEW) .EQ. 0.) GO TO 168
      XL = XNEW
      GO TO 170
  168 XH = XNEW
  170 CONTINUE
      XHIGH = XH
      WRITE(6,555) XHIGH, X2HIGH
C
  220 CONTINUE
      RETURN
  554 FORMAT('0CANNOT FIND NON-ZERO FUNCTION VALUE')
  555 FORMAT(' FUNCTION IS ZERO FROM X=',E12.5,' TO ',E12.5)
      END
Commit	Line	Data
fe4da5cc	1	SUBROUTINE FUNZER(FUNC,X2LOW,X2HIGH,XLOW,XHIGH)
	2	C FIND RANGE WHERE FUNC IS NON-ZERO.
	3	C WRITTEN 1980, F. JAMES
	4	C MODIFIED, NOV. 1985, TO FIX BUG AND GENERALIZE
	5	C TO FIND SIMPLY-CONNECTED NON-ZERO REGION (XLOW,XHIGH)
	6	C ANYWHERE WITHIN THE GIVEN REGION (X2LOW,H2HIGH).
	7	C WHERE 'ANYWHERE' MEANS EITHER AT THE LOWER OR UPPER
	8	C EDGE OF THE GIVEN REGION, OR, IF IN THE MIDDLE,
	9	C COVERING AT LEAST 1% OF THE GIVEN REGION.
	10	C OTHERWISE IT IS NOT GUARANTEED TO FIND THE NON-ZERO REGION.
	11	C IF FUNCTION EVERYWHERE ZERO, FUNZER SETS XLOW=XHIGH=0.
	12	EXTERNAL FUNC
	13	XLOW = X2LOW
	14	XHIGH = X2HIGH
	15	C FIND OUT IF FUNCTION IS ZERO AT ONE END OR BOTH
	16	XMID = XLOW
	17	IF (FUNC(XLOW) .GT. 0.) GO TO 120
	18	XMID = XHIGH
	19	IF (FUNC(XHIGH) .GT. 0.) GO TO 50
	20	C FUNCTION IS ZERO AT BOTH ENDS,
	21	C LOOK FOR PLACE WHERE IT IS NON-ZERO.
	22	DO 30 LOGN= 1, 7
	23	NSLICE = 2**LOGN
	24	DO 20 I= 1, NSLICE, 2
	25	XMID = XLOW + I * (XHIGH-XLOW) / NSLICE
	26	IF (FUNC(XMID) .GT. 0.) GO TO 50
	27	20 CONTINUE
	28	30 CONTINUE
	29	C FALLING THROUGH LOOP MEANS CANNOT FIND NON-ZERO VALUE
	30	WRITE(6,554)
	31	WRITE(6,555) XLOW, XHIGH
	32	XLOW = 0.
	33	XHIGH = 0.
	34	GO TO 220
	35	C
	36	50 CONTINUE
	37	C DELETE 'LEADING' ZERO RANGE
	38	XH = XMID
	39	XL = XLOW
	40	DO 70 K= 1, 20
	41	XNEW = 0.5*(XH+XL)
	42	IF (FUNC(XNEW) .EQ. 0.) GO TO 68
	43	XH = XNEW
	44	GO TO 70
	45	68 XL = XNEW
	46	70 CONTINUE
	47	XLOW = XL
	48	WRITE(6,555) X2LOW,XLOW
	49	120 CONTINUE
	50	IF (FUNC(XHIGH) .GT. 0.) GO TO 220
	51	C DELETE 'TRAILING' RANGE OF ZEROES
	52	XL = XMID
	53	XH = XHIGH
	54	DO 170 K= 1, 20
	55	XNEW = 0.5*(XH+XL)
	56	IF (FUNC(XNEW) .EQ. 0.) GO TO 168
	57	XL = XNEW
	58	GO TO 170
	59	168 XH = XNEW
	60	170 CONTINUE
	61	XHIGH = XH
	62	WRITE(6,555) XHIGH, X2HIGH
	63	C
	64	220 CONTINUE
65	RETURN
66	554 FORMAT('0CANNOT FIND NON-ZERO FUNCTION VALUE')
67	555 FORMAT(' FUNCTION IS ZERO FROM X=',E12.5,' TO ',E12.5)
68	END