1*DECK RADF3 2 SUBROUTINE RADF3 (IDO, L1, CC, CH, WA1, WA2) 3C***BEGIN PROLOGUE RADF3 4C***SUBSIDIARY 5C***PURPOSE Calculate the fast Fourier transform of subvectors of 6C length three. 7C***LIBRARY SLATEC (FFTPACK) 8C***TYPE SINGLE PRECISION (RADF3-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 variable TAUI by using 17C FORTRAN intrinsic function SQRT instead of a DATA 18C statement. 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 RADF3 24 DIMENSION CH(IDO,3,*), CC(IDO,L1,3), WA1(*), WA2(*) 25C***FIRST EXECUTABLE STATEMENT RADF3 26 TAUR = -.5 27 TAUI = .5*SQRT(3.) 28 DO 101 K=1,L1 29 CR2 = CC(1,K,2)+CC(1,K,3) 30 CH(1,1,K) = CC(1,K,1)+CR2 31 CH(1,3,K) = TAUI*(CC(1,K,3)-CC(1,K,2)) 32 CH(IDO,2,K) = CC(1,K,1)+TAUR*CR2 33 101 CONTINUE 34 IF (IDO .EQ. 1) RETURN 35 IDP2 = IDO+2 36 IF((IDO-1)/2.LT.L1) GO TO 104 37 DO 103 K=1,L1 38CDIR$ IVDEP 39 DO 102 I=3,IDO,2 40 IC = IDP2-I 41 DR2 = WA1(I-2)*CC(I-1,K,2)+WA1(I-1)*CC(I,K,2) 42 DI2 = WA1(I-2)*CC(I,K,2)-WA1(I-1)*CC(I-1,K,2) 43 DR3 = WA2(I-2)*CC(I-1,K,3)+WA2(I-1)*CC(I,K,3) 44 DI3 = WA2(I-2)*CC(I,K,3)-WA2(I-1)*CC(I-1,K,3) 45 CR2 = DR2+DR3 46 CI2 = DI2+DI3 47 CH(I-1,1,K) = CC(I-1,K,1)+CR2 48 CH(I,1,K) = CC(I,K,1)+CI2 49 TR2 = CC(I-1,K,1)+TAUR*CR2 50 TI2 = CC(I,K,1)+TAUR*CI2 51 TR3 = TAUI*(DI2-DI3) 52 TI3 = TAUI*(DR3-DR2) 53 CH(I-1,3,K) = TR2+TR3 54 CH(IC-1,2,K) = TR2-TR3 55 CH(I,3,K) = TI2+TI3 56 CH(IC,2,K) = TI3-TI2 57 102 CONTINUE 58 103 CONTINUE 59 RETURN 60 104 DO 106 I=3,IDO,2 61 IC = IDP2-I 62CDIR$ IVDEP 63 DO 105 K=1,L1 64 DR2 = WA1(I-2)*CC(I-1,K,2)+WA1(I-1)*CC(I,K,2) 65 DI2 = WA1(I-2)*CC(I,K,2)-WA1(I-1)*CC(I-1,K,2) 66 DR3 = WA2(I-2)*CC(I-1,K,3)+WA2(I-1)*CC(I,K,3) 67 DI3 = WA2(I-2)*CC(I,K,3)-WA2(I-1)*CC(I-1,K,3) 68 CR2 = DR2+DR3 69 CI2 = DI2+DI3 70 CH(I-1,1,K) = CC(I-1,K,1)+CR2 71 CH(I,1,K) = CC(I,K,1)+CI2 72 TR2 = CC(I-1,K,1)+TAUR*CR2 73 TI2 = CC(I,K,1)+TAUR*CI2 74 TR3 = TAUI*(DI2-DI3) 75 TI3 = TAUI*(DR3-DR2) 76 CH(I-1,3,K) = TR2+TR3 77 CH(IC-1,2,K) = TR2-TR3 78 CH(I,3,K) = TI2+TI3 79 CH(IC,2,K) = TI3-TI2 80 105 CONTINUE 81 106 CONTINUE 82 RETURN 83 END 84