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