1*DECK RADB5 2 SUBROUTINE RADB5 (IDO, L1, CC, CH, WA1, WA2, WA3, WA4) 3C***BEGIN PROLOGUE RADB5 4C***SUBSIDIARY 5C***PURPOSE Calculate the fast Fourier transform of subvectors of 6C length five. 7C***LIBRARY SLATEC (FFTPACK) 8C***TYPE SINGLE PRECISION (RADB5-S) 9C***AUTHOR Swarztrauber, P. N., (NCAR) 10C***ROUTINES CALLED (NONE) 11C***REVISION HISTORY (YYMMDD) 12C 790601 DATE WRITTEN 13C 830401 Modified to use SLATEC library source file format. 14C 860115 Modified by Ron Boisvert to adhere to Fortran 77 by 15C (a) changing dummy array size declarations (1) to (*), 16C (b) changing definition of variables PI, TI11, TI12, 17C TR11, TR12 by using FORTRAN intrinsic functions ATAN 18C and SIN instead of DATA statements. 19C 881128 Modified by Dick Valent to meet prologue standards. 20C 890831 Modified array declarations. (WRB) 21C 891214 Prologue converted to Version 4.0 format. (BAB) 22C 900402 Added TYPE section. (WRB) 23C***END PROLOGUE RADB5 24 DIMENSION CC(IDO,5,*), CH(IDO,L1,5), WA1(*), WA2(*), WA3(*), 25 + WA4(*) 26C***FIRST EXECUTABLE STATEMENT RADB5 27 PI = 4.*ATAN(1.) 28 TR11 = SIN(.1*PI) 29 TI11 = SIN(.4*PI) 30 TR12 = -SIN(.3*PI) 31 TI12 = SIN(.2*PI) 32 DO 101 K=1,L1 33 TI5 = CC(1,3,K)+CC(1,3,K) 34 TI4 = CC(1,5,K)+CC(1,5,K) 35 TR2 = CC(IDO,2,K)+CC(IDO,2,K) 36 TR3 = CC(IDO,4,K)+CC(IDO,4,K) 37 CH(1,K,1) = CC(1,1,K)+TR2+TR3 38 CR2 = CC(1,1,K)+TR11*TR2+TR12*TR3 39 CR3 = CC(1,1,K)+TR12*TR2+TR11*TR3 40 CI5 = TI11*TI5+TI12*TI4 41 CI4 = TI12*TI5-TI11*TI4 42 CH(1,K,2) = CR2-CI5 43 CH(1,K,3) = CR3-CI4 44 CH(1,K,4) = CR3+CI4 45 CH(1,K,5) = CR2+CI5 46 101 CONTINUE 47 IF (IDO .EQ. 1) RETURN 48 IDP2 = IDO+2 49 IF((IDO-1)/2.LT.L1) GO TO 104 50 DO 103 K=1,L1 51CDIR$ IVDEP 52 DO 102 I=3,IDO,2 53 IC = IDP2-I 54 TI5 = CC(I,3,K)+CC(IC,2,K) 55 TI2 = CC(I,3,K)-CC(IC,2,K) 56 TI4 = CC(I,5,K)+CC(IC,4,K) 57 TI3 = CC(I,5,K)-CC(IC,4,K) 58 TR5 = CC(I-1,3,K)-CC(IC-1,2,K) 59 TR2 = CC(I-1,3,K)+CC(IC-1,2,K) 60 TR4 = CC(I-1,5,K)-CC(IC-1,4,K) 61 TR3 = CC(I-1,5,K)+CC(IC-1,4,K) 62 CH(I-1,K,1) = CC(I-1,1,K)+TR2+TR3 63 CH(I,K,1) = CC(I,1,K)+TI2+TI3 64 CR2 = CC(I-1,1,K)+TR11*TR2+TR12*TR3 65 CI2 = CC(I,1,K)+TR11*TI2+TR12*TI3 66 CR3 = CC(I-1,1,K)+TR12*TR2+TR11*TR3 67 CI3 = CC(I,1,K)+TR12*TI2+TR11*TI3 68 CR5 = TI11*TR5+TI12*TR4 69 CI5 = TI11*TI5+TI12*TI4 70 CR4 = TI12*TR5-TI11*TR4 71 CI4 = TI12*TI5-TI11*TI4 72 DR3 = CR3-CI4 73 DR4 = CR3+CI4 74 DI3 = CI3+CR4 75 DI4 = CI3-CR4 76 DR5 = CR2+CI5 77 DR2 = CR2-CI5 78 DI5 = CI2-CR5 79 DI2 = CI2+CR5 80 CH(I-1,K,2) = WA1(I-2)*DR2-WA1(I-1)*DI2 81 CH(I,K,2) = WA1(I-2)*DI2+WA1(I-1)*DR2 82 CH(I-1,K,3) = WA2(I-2)*DR3-WA2(I-1)*DI3 83 CH(I,K,3) = WA2(I-2)*DI3+WA2(I-1)*DR3 84 CH(I-1,K,4) = WA3(I-2)*DR4-WA3(I-1)*DI4 85 CH(I,K,4) = WA3(I-2)*DI4+WA3(I-1)*DR4 86 CH(I-1,K,5) = WA4(I-2)*DR5-WA4(I-1)*DI5 87 CH(I,K,5) = WA4(I-2)*DI5+WA4(I-1)*DR5 88 102 CONTINUE 89 103 CONTINUE 90 RETURN 91 104 DO 106 I=3,IDO,2 92 IC = IDP2-I 93CDIR$ IVDEP 94 DO 105 K=1,L1 95 TI5 = CC(I,3,K)+CC(IC,2,K) 96 TI2 = CC(I,3,K)-CC(IC,2,K) 97 TI4 = CC(I,5,K)+CC(IC,4,K) 98 TI3 = CC(I,5,K)-CC(IC,4,K) 99 TR5 = CC(I-1,3,K)-CC(IC-1,2,K) 100 TR2 = CC(I-1,3,K)+CC(IC-1,2,K) 101 TR4 = CC(I-1,5,K)-CC(IC-1,4,K) 102 TR3 = CC(I-1,5,K)+CC(IC-1,4,K) 103 CH(I-1,K,1) = CC(I-1,1,K)+TR2+TR3 104 CH(I,K,1) = CC(I,1,K)+TI2+TI3 105 CR2 = CC(I-1,1,K)+TR11*TR2+TR12*TR3 106 CI2 = CC(I,1,K)+TR11*TI2+TR12*TI3 107 CR3 = CC(I-1,1,K)+TR12*TR2+TR11*TR3 108 CI3 = CC(I,1,K)+TR12*TI2+TR11*TI3 109 CR5 = TI11*TR5+TI12*TR4 110 CI5 = TI11*TI5+TI12*TI4 111 CR4 = TI12*TR5-TI11*TR4 112 CI4 = TI12*TI5-TI11*TI4 113 DR3 = CR3-CI4 114 DR4 = CR3+CI4 115 DI3 = CI3+CR4 116 DI4 = CI3-CR4 117 DR5 = CR2+CI5 118 DR2 = CR2-CI5 119 DI5 = CI2-CR5 120 DI2 = CI2+CR5 121 CH(I-1,K,2) = WA1(I-2)*DR2-WA1(I-1)*DI2 122 CH(I,K,2) = WA1(I-2)*DI2+WA1(I-1)*DR2 123 CH(I-1,K,3) = WA2(I-2)*DR3-WA2(I-1)*DI3 124 CH(I,K,3) = WA2(I-2)*DI3+WA2(I-1)*DR3 125 CH(I-1,K,4) = WA3(I-2)*DR4-WA3(I-1)*DI4 126 CH(I,K,4) = WA3(I-2)*DI4+WA3(I-1)*DR4 127 CH(I-1,K,5) = WA4(I-2)*DR5-WA4(I-1)*DI5 128 CH(I,K,5) = WA4(I-2)*DI5+WA4(I-1)*DR5 129 105 CONTINUE 130 106 CONTINUE 131 RETURN 132 END 133