[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / divon / bndtst.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1996/04/01 15:03:26  mclareni
* Mathlib gen
*
*
#include "gen/pilot.h"
      SUBROUTINE BNDTST (N,X,XLOW,XHI,BNDTOL,NFREE,IFREE,NACTV,IACTV,XAL
     1TER)
      INTEGER N, NFREE, NACTV
      INTEGER IFREE(N), IACTV(N)
      LOGICAL XALTER
      DOUBLE PRECISION BNDTOL
      DOUBLE PRECISION X(N), XLOW(N), XHI(N)
      INTEGER I
CMM   DOUBLE PRECISION DABS, XDENOM
      DOUBLE PRECISION       XDENOM
      XALTER=.FALSE.
      NFREE=0
      NACTV=0
      DO 30 I=1,N
      XDENOM=1.0D+0+ABS(XHI(I))
      IF((X(I)-XHI(I))/XDENOM.GE.(-BNDTOL)) GOTO 10
      XDENOM=1.0D+0+ABS(XLOW(I))
      IF((X(I)-XLOW(I))/XDENOM.LE.BNDTOL) GOTO 20
      NFREE=NFREE+1
      IFREE(NFREE)=I
      GOTO 30
 10   X(I)=XHI(I)
      XALTER=.TRUE.
      NACTV=NACTV+1
      IACTV(NACTV)=-I
      GOTO 30
 20   X(I)=XLOW(I)
      XALTER=.TRUE.
      NACTV=NACTV+1
      IACTV(NACTV)=I
 30   CONTINUE
      RETURN
      END
Commit	Line	Data
fe4da5cc	1	*
	2	* $Id$
	3	*
	4	* $Log$
	5	* Revision 1.1.1.1 1996/04/01 15:03:26 mclareni
	6	* Mathlib gen
	7	*
	8	*
	9	#include "gen/pilot.h"
	10	SUBROUTINE BNDTST (N,X,XLOW,XHI,BNDTOL,NFREE,IFREE,NACTV,IACTV,XAL
	11	1TER)
	12	INTEGER N, NFREE, NACTV
	13	INTEGER IFREE(N), IACTV(N)
	14	LOGICAL XALTER
	15	DOUBLE PRECISION BNDTOL
	16	DOUBLE PRECISION X(N), XLOW(N), XHI(N)
	17	INTEGER I
	18	CMM DOUBLE PRECISION DABS, XDENOM
	19	DOUBLE PRECISION XDENOM
	20	XALTER=.FALSE.
	21	NFREE=0
	22	NACTV=0
	23	DO 30 I=1,N
	24	XDENOM=1.0D+0+ABS(XHI(I))
	25	IF((X(I)-XHI(I))/XDENOM.GE.(-BNDTOL)) GOTO 10
	26	XDENOM=1.0D+0+ABS(XLOW(I))
	27	IF((X(I)-XLOW(I))/XDENOM.LE.BNDTOL) GOTO 20
	28	NFREE=NFREE+1
	29	IFREE(NFREE)=I
	30	GOTO 30
	31	10 X(I)=XHI(I)
	32	XALTER=.TRUE.
	33	NACTV=NACTV+1
	34	IACTV(NACTV)=-I
	35	GOTO 30
	36	20 X(I)=XLOW(I)
	37	XALTER=.TRUE.
	38	NACTV=NACTV+1
	39	IACTV(NACTV)=I
	40	30 CONTINUE
	41	RETURN
	42	END