MINICERN/mathlib/gen/d/i128.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/04/01 15:02:23  mclareni
   6 * Mathlib gen
   7 *
   8 *
   9 #include "gen/pilot.h"
  10       SUBROUTINE I128(C,D,IX,F,G,IZ)
  11       REAL C(1),D(1),F(1),G(1),A(128),B(128)
  12       COMMON /TAB/E(253)
  13       IND = 0
  14       GOTO 20
  15 #if (defined(CERNLIB_CDC))&&(defined(CERNLIB_F4))
  16       ENTRY D128
  17 #endif
  18 #if !defined(CERNLIB_CDC)||!defined(CERNLIB_F4)
  19       ENTRY D128(C,D,IX,F,G,IZ)
  20 #endif
  21       IND = 1
  22    20 IT = 1+IX
  23       JT = IX+IX
  24       CALL I64(C,D,JT,A,A(2),2)
  25       CALL I64(C(IT),D(IT),JT,B,B(2),2)
  26       IF(IND.EQ.1) GOTO 30
  27       IS = IZ
  28       MZ = 1
  29       LZ = 32*IZ
  30       KZ = 1+LZ
  31       JZ = KZ+LZ
  32       LZ = JZ+LZ
  33       GOTO 40
  34    30 IS = -IZ
  35       MZ = 32*IZ
  36       LZ = 1+MZ
  37       JZ = MZ+LZ
  38       KZ = JZ+MZ
  39       MZ = KZ+MZ
  40    40 F(1) = A(1)+B(1)
  41       G(1) = A(2)+B(2)
  42       F(JZ) = A(1)-B(1)
  43       G(JZ) = A(2)-B(2)
  44       F(KZ) = A(65)+B(66)
  45       G(KZ) = A(66)-B(65)
  46       F(LZ) = A(65)-B(66)
  47       G(LZ) = A(66)+B(65)
  48       DO 10 I=1,61,2
  49       K = I+66
  50       MZ = MZ+IS
  51       JZ = JZ+IS
  52       KZ = KZ+IS
  53       LZ = LZ+IS
  54       E1 = E(2*I+2)
  55       E2 = E(2*I+1)
  56       B1R = B(I+2)*E1+B(I+3)*E2
  57       B1I = B(I+3)*E1-B(I+2)*E2
  58       B2R = B(K+1)*E1-B(K)*E2
  59       B2I = -B(K)*E1-B(K+1)*E2
  60       F(MZ) = A(I+2)+B1R
  61       G(MZ) = A(I+3)+B1I
  62       F(JZ) = A(I+2)-B1R
  63       G(JZ) = A(I+3)-B1I
  64       F(KZ) = A(K)+B2R
  65       G(KZ) = A(K+1)+B2I
  66       F(LZ) = A(K)-B2R
  67    10 G(LZ) = A(K+1)-B2I
  68       RETURN
  69       END