MINICERN/mathlib/gen/e/dtrgsm.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/04/01 15:02:29  mclareni
   6 * Mathlib gen
   7 *
   8 *
   9 #include "gen/pilot.h"
  10       FUNCTION DTRGSM(X,A,N,B,M,IOP)
  11 #if !defined(CERNLIB_DOUBLE)
  12 #include "gen/imp128.inc"
  13       CHARACTER*6 NAME
  14       NAME  ='DTRGSM'
  15       CALL MTLPRT(NAME,'E409',
  16      +'not available on this machine - see documentation')
  17       DTRGSM=0.0
  18       RETURN
  19       END
  20 #endif
  21 #if defined(CERNLIB_DOUBLE)
  22       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
  23
  24       DIMENSION A(0:*),B(*)
  25
  26       PARAMETER (R1 = 1, HF = R1/2)
  27
  28       C=2*COS(X)
  29       H=0
  30       IF(IOP .NE. 3) THEN
  31        A2=0
  32        A1=0
  33        A0=A(N)
  34        DO 1 K = N-1,0,-1
  35        A2=A1
  36        A1=A0
  37        A0=A(K)+C*A1-A2
  38     1  CONTINUE
  39        H=HF*(A(0)+A0-A2)
  40       ENDIF
  41       IF(IOP .NE. 2) THEN
  42        A2=0
  43        A1=0
  44        A0=B(M)
  45        DO 2 K = M-1,1,-1
  46        A2=A1
  47        A1=A0
  48        A0=B(K)+C*A1-A2
  49     2  CONTINUE
  50        H=H+A0*SIN(X)
  51       ENDIF
  52       DTRGSM=H
  53       RETURN
  54       END
  55 #endif