1#if defined(XLF14) || defined(XLFLINUX)
2@PROCESS OPT(0) STRICT(ALL)
3#endif
4C****************************************************************
5C   Translated by Pacific-Sierra Research VAST-2
6C   Version 6.1C1 on 12/ 8/97 at 23:36:36
7C****************************************************************
8C
9      subroutine dradb4 (ido,l1,cc,ch,wa1,wa2,wa3)
10*
11* $Id$
12*
13*
14* $Id$
15*
16      double precision cc(ido,4,l1), ch(ido,l1,4), wa1(1), wa2(1),
17     1  wa3(1), ci2, ci3, ci4, cr2, cr3, cr4, sqrt2, ti1, ti2, ti3, ti4,
18     2  tr1, tr2, tr3, tr4
19      data sqrt2 /  1.414213562 3730950488 0168872420 970 d0 /
20c
21      do 101 k=1,l1
22         tr1 = cc(1,1,k)-cc(ido,4,k)
23         tr2 = cc(1,1,k)+cc(ido,4,k)
24         tr3 = cc(ido,2,k)+cc(ido,2,k)
25         tr4 = cc(1,3,k)+cc(1,3,k)
26         ch(1,k,1) = tr2+tr3
27         ch(1,k,2) = tr1-tr4
28         ch(1,k,3) = tr2-tr3
29         ch(1,k,4) = tr1+tr4
30  101 continue
31c
32      if (ido - 2 .lt. 0) go to 107
33      if (ido - 2 .eq. 0) go to 105
34  102 continue
35      idp2 = ido + 2
36      do 104 k=1,l1
37      do i = 1, ((ido - 1)/2)
38         ti1 = cc(1+i*2,1,k) + cc(idp2-1-i*2,4,k)
39         ti2 = cc(1+i*2,1,k) - cc(idp2-1-i*2,4,k)
40         ti3 = cc(1+i*2,3,k) - cc(idp2-1-i*2,2,k)
41         tr4 = cc(1+i*2,3,k) + cc(idp2-1-i*2,2,k)
42         tr1 = cc(i*2,1,k) - cc(idp2-(i+1)*2,4,k)
43         tr2 = cc(i*2,1,k) + cc(idp2-(i+1)*2,4,k)
44         ti4 = cc(i*2,3,k) - cc(idp2-(i+1)*2,2,k)
45         tr3 = cc(i*2,3,k) + cc(idp2-(i+1)*2,2,k)
46         ch(i*2,k,1) = tr2 + tr3
47         cr3 = tr2 - tr3
48         ch(1+i*2,k,1) = ti2 + ti3
49         ci3 = ti2 - ti3
50         cr2 = tr1 - tr4
51         cr4 = tr1 + tr4
52         ci2 = ti1 + ti4
53         ci4 = ti1 - ti4
54         ch(i*2,k,2) = wa1(i*2-1)*cr2 - wa1(i*2)*ci2
55         ch(1+i*2,k,2) = wa1(i*2-1)*ci2 + wa1(i*2)*cr2
56         ch(i*2,k,3) = wa2(i*2-1)*cr3 - wa2(i*2)*ci3
57         ch(1+i*2,k,3) = wa2(i*2-1)*ci3 + wa2(i*2)*cr3
58         ch(i*2,k,4) = wa3(i*2-1)*cr4 - wa3(i*2)*ci4
59         ch(1+i*2,k,4) = wa3(i*2-1)*ci4 + wa3(i*2)*cr4
60      end do
61  104 continue
62      if (mod(ido,2) .eq. 1) return
63c
64  105 continue
65      do 106 k=1,l1
66         ti1 = cc(1,2,k)+cc(1,4,k)
67         ti2 = cc(1,4,k)-cc(1,2,k)
68         tr1 = cc(ido,1,k)-cc(ido,3,k)
69         tr2 = cc(ido,1,k)+cc(ido,3,k)
70         ch(ido,k,1) = tr2+tr2
71         ch(ido,k,2) = sqrt2*(tr1-ti1)
72         ch(ido,k,3) = ti2+ti2
73         ch(ido,k,4) = -sqrt2*(tr1+ti1)
74  106 continue
75c
76  107 return
77      end
78