RADF4M.inc
References to this file elsewhere.
1 C***********************************************************************
2 SUBROUTINE RADF4M (INC,LOT,IDO,L1,CC,CH,WA1,WA2,WA3)
3 DIMENSION CC(INC,IDO,L1,4) ,CH(INC,IDO,4,L1)
4 1 ,WA1(*) ,WA2(*) ,WA3(*)
5 DATA HSQT2 /.70710678118654750/
6 DO 101 K=1,L1
7 *VOPTION NOFVAL
8 DO 101 L=1,LOT
9 TR1 = CC(L,1,K,2)+CC(L,1,K,4)
10 TR2 = CC(L,1,K,1)+CC(L,1,K,3)
11 CH(L, 1,3,K) = CC(L,1,K,4)-CC(L,1,K,2)
12 CH(L, 1,1,K) = TR1+TR2
13 CH(L,IDO,2,K) = CC(L,1,K,1)-CC(L,1,K,3)
14 CH(L,IDO,4,K) = TR2-TR1
15 101 CONTINUE
16 IF (MOD(IDO,2) .EQ. 0) THEN
17 DO 102 K=1,L1
18 *VOPTION NOFVAL
19 DO 102 L=1,LOT
20 TR1 = HSQT2*(CC(L,IDO,K,2)-CC(L,IDO,K,4))
21 TI1 = -HSQT2*(CC(L,IDO,K,2)+CC(L,IDO,K,4))
22 CH(L,IDO,1,K) = CC(L,IDO,K,1)+TR1
23 CH(L, 1,2,K) = TI1 -CC(L,IDO,K,3)
24 CH(L,IDO,3,K) = CC(L,IDO,K,1)-TR1
25 CH(L, 1,4,K) = TI1 +CC(L,IDO,K,3)
26 102 CONTINUE
27 END IF
28 IF (IDO .GT. 2) THEN
29 IDP2 = IDO+2
30 DO 104 K=1,L1
31 *VOPTION NOFVAL
32 DO 104 I=3,IDO,2
33 IC = IDP2-I
34 *VOPTION NOFVAL
35 DO 103 L=1,LOT
36 CR2 = WA1(I-2)*CC(L,I-1,K,2)+WA1(I-1)*CC(L,I ,K,2)
37 CI2 = WA1(I-2)*CC(L,I ,K,2)-WA1(I-1)*CC(L,I-1,K,2)
38 CR3 = WA2(I-2)*CC(L,I-1,K,3)+WA2(I-1)*CC(L,I ,K,3)
39 CI3 = WA2(I-2)*CC(L,I ,K,3)-WA2(I-1)*CC(L,I-1,K,3)
40 CR4 = WA3(I-2)*CC(L,I-1,K,4)+WA3(I-1)*CC(L,I ,K,4)
41 CI4 = WA3(I-2)*CC(L,I ,K,4)-WA3(I-1)*CC(L,I-1,K,4)
42 TR2 = CC(L,I-1,K,1)+CR3
43 TI2 = CC(L,I ,K,1)+CI3
44 TR1 = CR2+CR4
45 TI1 = CI2+CI4
46 TR3 = CC(L,I-1,K,1)-CR3
47 TI3 = CC(L,I ,K,1)-CI3
48 TR4 = CR4-CR2
49 TI4 = CI2-CI4
50 CH(L,I -1,1,K) = TR1+TR2
51 CH(L,I ,1,K) = TI1+TI2
52 CH(L,IC-1,2,K) = TR3-TI4
53 CH(L,IC ,2,K) = TR4-TI3
54 CH(L,I -1,3,K) = TI4+TR3
55 CH(L,I ,3,K) = TR4+TI3
56 CH(L,IC-1,4,K) = TR2-TR1
57 CH(L,IC ,4,K) = TI1-TI2
58 103 CONTINUE
59 104 CONTINUE
60 END IF
61 RETURN
62 END SUBROUTINE RADF4M
63