MINICERN/mathlib/gen/d/rknys64.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/04/01 15:02:17  mclareni
   6 * Mathlib gen
   7 *
   8 *
   9 #include "gen/pilot.h"
  10 #if defined(CERNLIB_DOUBLE)
  11       SUBROUTINE DRKNYS(N,H,X,Y,YP,SUB,W)
  12 C
  13 #include "gen/imp64.inc"
  14 C
  15       CHARACTER*(*) NAME
  16       PARAMETER(NAME='DRKNYS')
  17 #endif
  18 #if !defined(CERNLIB_DOUBLE)
  19       SUBROUTINE RRKNYS(N,H,X,Y,YP,SUB,W)
  20 C
  21       CHARACTER*(*) NAME
  22       PARAMETER(NAME='RRKNYS')
  23 #endif
  24       DIMENSION Y(*),YP(*),W(N,*)
  25
  26       PARAMETER (Z1 = 1, R2 = Z1/2, R6 = Z1/6, R8 = Z1/8)
  27
  28 #if !defined(CERNLIB_DOUBLE)
  29       ENTRY RKNYS(N,H,X,Y,YP,SUB,W)
  30 #endif
  31
  32       IF(N .LE. 0 .OR. H .EQ. 0) RETURN
  33       H2=R2*H
  34       H6=R6*H
  35       HH2=H*H2
  36       HH6=H*H6
  37       HH8=R8*H*H
  38       XH=X+H
  39       XH2=X+H2
  40       CALL SUB(X,Y,YP,W(1,1))
  41       DO 1 J = 1,N
  42       W(J,4)=Y(J)+H2*YP(J)
  43       W(J,5)=W(J,4)+HH8*W(J,1)
  44     1 W(J,6)=YP(J)+H2*W(J,1)
  45       CALL SUB(XH2,W(1,5),W(1,6),W(1,2))
  46       DO 2 J = 1,N
  47       W(J,6)=YP(J)+H2*W(J,2)
  48       W(J,1)=W(J,1)+W(J,2)
  49     2 W(J,2)=W(J,1)+W(J,2)
  50       CALL SUB(XH2,W(1,5),W(1,6),W(1,3))
  51       DO 3 J = 1,N
  52       W(J,4)=W(J,4)+H2*YP(J)
  53       W(J,5)=W(J,4)+HH2*W(J,3)
  54       W(J,6)=YP(J)+H*W(J,3)
  55       W(J,1)=W(J,1)+W(J,3)
  56     3 W(J,2)=W(J,2)+2*W(J,3)
  57       CALL SUB(XH,W(1,5),W(1,6),W(1,3))
  58       DO 4 J = 1,N
  59       Y(J)=W(J,4)+HH6*W(J,1)
  60     4 YP(J)=YP(J)+H6*(W(J,2)+W(J,3))
  61       X=XH
  62       RETURN
  63       END