This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / divon / mulchk.F
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