MINICERN/mathlib/gen/divon/nocut.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/04/01 15:03:25  mclareni
   6 * Mathlib gen
   7 *
   8 *
   9 #include "gen/pilot.h"
  10       SUBROUTINE NOCUT (N,XLOW,XUP,Z,IDSCNT,IDSCRM,PARTN,NFCNT)
  11       INTEGER N, IDSCNT, IDSCRM, NFCNT
  12       DOUBLE PRECISION PARTN
  13       DOUBLE PRECISION XLOW(N), XUP(N), Z(N)
  14       INTEGER I, MOD
  15 CMM   DOUBLE PRECISION DABS, DEVMAX, DFUN, XSAVE, YMID, YLOW, YUP, YDIF
  16       DOUBLE PRECISION       DEVMAX, DFUN, XSAVE, YMID, YLOW, YUP, YDIF
  17       DEVMAX=0.0D+0
  18       DO 10 I=1,N
  19       Z(I)=0.5D+0*(XLOW(I)+XUP(I))
  20  10   CONTINUE
  21       YMID=DFUN(N,Z)
  22       DO 30 I=1,N
  23       XSAVE=Z(I)
  24       Z(I)=XLOW(I)
  25       YLOW=DFUN(N,Z)
  26       Z(I)=XUP(I)
  27       YUP=DFUN(N,Z)
  28       YDIF=ABS(YMID-0.5D+0*(YLOW+YUP))
  29       IF(YDIF.LT.DEVMAX) GOTO 20
  30       DEVMAX=YDIF
  31       PARTN=XSAVE
  32       IDSCRM=I
  33  20   Z(I)=XSAVE
  34  30   CONTINUE
  35       NFCNT=NFCNT+2*N+1
  36       IF(DEVMAX.NE.0.0D+0) GOTO 40
  37       IDSCRM=MOD(IDSCNT,N)+1
  38       PARTN=Z(IDSCRM)
  39       IDSCNT=IDSCNT+1
  40       RETURN
  41  40   IDSCNT=0
  42       RETURN
  43       END