MINICERN/mathlib/gen/d/vd01a.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/04/01 15:02:20  mclareni
   6 * Mathlib gen
   7 *
   8 *
   9 #include "gen/pilot.h"
  10       SUBROUTINE VD01A (ITEST,X,F,MAXFUN,ABSACC,RELACC,XSTEP)
  11       GO TO (1,2,2),ITEST
  12     2 IS=6-ITEST
  13       ITEST=1
  14       IINC=1
  15       XINC=XSTEP+XSTEP
  16       MC=IS-3
  17       IF (MC) 4,4,15
  18     3 MC=MC+1
  19       IF (MAXFUN-MC) 12,15,15
  20    12 ITEST=4
  21    43 X=DB
  22       F=FB
  23       IF (FB-FC) 15,15,44
  24    44 X=DC
  25       F=FC
  26    15 RETURN
  27     1 GO TO (5,6,7,8),IS
  28     8 IS=3
  29     4 DC=X
  30       FC=F
  31       X=X+XSTEP
  32       GO TO 3
  33     7 IF (FC-F) 9,10,11
  34    10 X=X+XINC
  35       XINC=XINC+XINC
  36       GO TO 3
  37     9 DB=X
  38       FB=F
  39       XINC=-XINC
  40       GO TO 13
  41    11 DB=DC
  42       FB=FC
  43       DC=X
  44       FC=F
  45    13 X=DC+DC-DB
  46       IS=2
  47       GO TO 3
  48     6 DA=DB
  49       DB=DC
  50       FA=FB
  51       FB=FC
  52    32 DC=X
  53       FC=F
  54       GO TO 14
  55     5 IF (FB-FC) 16,17,17
  56    17 IF (F-FB) 18,32,32
  57    18 FA=FB
  58       DA=DB
  59    19 FB=F
  60       DB=X
  61       GO TO 14
  62    16 IF (FA-FC) 21,21,20
  63    20 XINC=FA
  64       FA=FC
  65       FC=XINC
  66       XINC=DA
  67       DA=DC
  68       DC=XINC
  69    21 XINC=DC
  70       IF ((D-DB)*(D-DC)) 32,22,22
  71    22 IF (F-FA) 23,24,24
  72    23 FC=FB
  73       DC=DB
  74       GO TO 19
  75    24 FA=F
  76       DA=X
  77    14 IF (FB-FC) 25,25,29
  78    25 IINC=2
  79       XINC=DC
  80       IF (FB-FC) 29,45,29
  81    29 D=(FA-FB)/(DA-DB)-(FA-FC)/(DA-DC)
  82       IF (D*(DB-DC)) 33,33,37
  83    37 D=0.5*(DB+DC-(FB-FC)/D)
  84       IF (ABS (D-X)-ABS (ABSACC)) 34,34,35
  85    35 IF (ABS (D-X)-ABS (D*RELACC)) 34,34,36
  86    34 ITEST=2
  87       GO TO 43
  88    36 IS=1
  89       X=D
  90       IF ((DA-DC)*(DC-D)) 3,26,38
  91    38 IS=2
  92       GO TO (39,40),IINC
  93    39 IF (ABS (XINC)-ABS (DC-D)) 41,3,3
  94    33 IS=2
  95       GO TO (41,42),IINC
  96    41 X=DC
  97       GO TO 10
  98    40 IF (ABS (XINC-X)-ABS (X-DC)) 42,42,3
  99    42 X=0.5*(XINC+DC)
 100       IF ((XINC-X)*(X-DC)) 26,26,3
 101    45 X=0.5*(DB+DC)
 102       IF ((DB-X)*(X-DC)) 26,26,3
 103    26 ITEST=3
 104       GO TO 43
 105       END