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