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