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

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1996/04/01 15:03:27  mclareni
* Mathlib gen
*
*
#include "gen/pilot.h"
      SUBROUTINE FEASMV (N,NFREE,IFREE,X,PFREE,XLOW,XHI,TOL,STEPMX,INEW,
     1IDNEW)
      INTEGER N, NFREE, INEW, IDNEW
      INTEGER IFREE(NFREE)
      DOUBLE PRECISION TOL, STEPMX
      DOUBLE PRECISION X(N), PFREE(NFREE), XLOW(N), XHI(N)
      INTEGER I, IDIR, II
      DOUBLE PRECISION STEP
C*NS  DOUBLE PRECISION DABS
      STEPMX=1.0D+30
      DO 30 I=1,NFREE
      II=IFREE(I)
      IF(ABS(PFREE(I)).LT.TOL) GOTO 30
      IF(PFREE(I).GT.0.0D+0) GOTO 10
      STEP=(XLOW(II)-X(II))/PFREE(I)
      IDIR=1
      GOTO 20
 10   STEP=(XHI(II)-X(II))/PFREE(I)
      IDIR=-1
 20   IF(STEP.GE.STEPMX) GOTO 30
      STEPMX=STEP
      INEW=II
      IDNEW=IDIR
 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 FEASMV (N,NFREE,IFREE,X,PFREE,XLOW,XHI,TOL,STEPMX,INEW,
	11	1IDNEW)
	12	INTEGER N, NFREE, INEW, IDNEW
	13	INTEGER IFREE(NFREE)
	14	DOUBLE PRECISION TOL, STEPMX
	15	DOUBLE PRECISION X(N), PFREE(NFREE), XLOW(N), XHI(N)
	16	INTEGER I, IDIR, II
	17	DOUBLE PRECISION STEP
	18	C*NS DOUBLE PRECISION DABS
	19	STEPMX=1.0D+30
	20	DO 30 I=1,NFREE
	21	II=IFREE(I)
	22	IF(ABS(PFREE(I)).LT.TOL) GOTO 30
	23	IF(PFREE(I).GT.0.0D+0) GOTO 10
	24	STEP=(XLOW(II)-X(II))/PFREE(I)
	25	IDIR=1
	26	GOTO 20
	27	10 STEP=(XHI(II)-X(II))/PFREE(I)
	28	IDIR=-1
	29	20 IF(STEP.GE.STEPMX) GOTO 30
	30	STEPMX=STEP
	31	INEW=II
	32	IDNEW=IDIR
	33	30 CONTINUE
	34	RETURN
	35	END