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

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1996/04/01 15:03:27  mclareni
* Mathlib gen
*
*
#include "gen/pilot.h"
      SUBROUTINE MULCHK (N,NACTV,IACTV,IIMIN,TOL,X,XHI,FTRUE,DELTA,XTEMP
     1,GACTV,NEGMUL,IBDEL,IBTRUE)
      INTEGER N, NACTV, IIMIN, IBDEL, IBTRUE
      INTEGER IACTV(NACTV)
      LOGICAL NEGMUL
      DOUBLE PRECISION FTRUE, DELTA, TOL
      DOUBLE PRECISION X(N), XHI(N), XTEMP(N), GACTV(NACTV)
      INTEGER I
      DOUBLE PRECISION SIG, XLTEST, XMULOW
      CALL GRDCMP(N,NACTV,IACTV,X,FTRUE,DELTA,XHI,XTEMP,GACTV)
      IF(IIMIN.EQ.1) GOTO 20
      DO 10 I=1,NACTV
      GACTV(I)=-GACTV(I)
 10   CONTINUE
 20   NEGMUL=.FALSE.
      IBDEL=0
      IBTRUE=0
      XMULOW=0.0D+0
      DO 30 I=1,NACTV
      SIG=1.0D+0
      IF(IACTV(I).LT.0) SIG=-1.0D+0
      XLTEST=GACTV(I)*SIG
      IF(XLTEST.GE.(-TOL)) GOTO 30
      NEGMUL=.TRUE.
      IF(XLTEST.GE.XMULOW) GOTO 30
      XMULOW=XLTEST
      IBDEL=I
      IBTRUE=IACTV(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:27 mclareni
	6	* Mathlib gen
	7	*
	8	*
	9	#include "gen/pilot.h"
	10	SUBROUTINE MULCHK (N,NACTV,IACTV,IIMIN,TOL,X,XHI,FTRUE,DELTA,XTEMP
	11	1,GACTV,NEGMUL,IBDEL,IBTRUE)
	12	INTEGER N, NACTV, IIMIN, IBDEL, IBTRUE
	13	INTEGER IACTV(NACTV)
	14	LOGICAL NEGMUL
	15	DOUBLE PRECISION FTRUE, DELTA, TOL
	16	DOUBLE PRECISION X(N), XHI(N), XTEMP(N), GACTV(NACTV)
	17	INTEGER I
	18	DOUBLE PRECISION SIG, XLTEST, XMULOW
	19	CALL GRDCMP(N,NACTV,IACTV,X,FTRUE,DELTA,XHI,XTEMP,GACTV)
	20	IF(IIMIN.EQ.1) GOTO 20
	21	DO 10 I=1,NACTV
	22	GACTV(I)=-GACTV(I)
	23	10 CONTINUE
	24	20 NEGMUL=.FALSE.
	25	IBDEL=0
	26	IBTRUE=0
	27	XMULOW=0.0D+0
	28	DO 30 I=1,NACTV
	29	SIG=1.0D+0
	30	IF(IACTV(I).LT.0) SIG=-1.0D+0
	31	XLTEST=GACTV(I)*SIG
	32	IF(XLTEST.GE.(-TOL)) GOTO 30
	33	NEGMUL=.TRUE.
	34	IF(XLTEST.GE.XMULOW) GOTO 30
	35	XMULOW=XLTEST
	36	IBDEL=I
	37	IBTRUE=IACTV(I)
	38	30 CONTINUE
	39	RETURN
	40	END