1*DECK PASSF4 2 SUBROUTINE PASSF4 (IDO, L1, CC, CH, WA1, WA2, WA3) 3C***BEGIN PROLOGUE PASSF4 4C***SUBSIDIARY 5C***PURPOSE Calculate the fast Fourier transform of subvectors of 6C length four. 7C***LIBRARY SLATEC (FFTPACK) 8C***TYPE SINGLE PRECISION (PASSF4-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 changing dummy array size declarations (1) to (*). 16C 881128 Modified by Dick Valent to meet prologue standards. 17C 890831 Modified array declarations. (WRB) 18C 891214 Prologue converted to Version 4.0 format. (BAB) 19C 900402 Added TYPE section. (WRB) 20C***END PROLOGUE PASSF4 21 DIMENSION CC(IDO,4,*), CH(IDO,L1,4), WA1(*), WA2(*), WA3(*) 22C***FIRST EXECUTABLE STATEMENT PASSF4 23 IF (IDO .NE. 2) GO TO 102 24 DO 101 K=1,L1 25 TI1 = CC(2,1,K)-CC(2,3,K) 26 TI2 = CC(2,1,K)+CC(2,3,K) 27 TR4 = CC(2,2,K)-CC(2,4,K) 28 TI3 = CC(2,2,K)+CC(2,4,K) 29 TR1 = CC(1,1,K)-CC(1,3,K) 30 TR2 = CC(1,1,K)+CC(1,3,K) 31 TI4 = CC(1,4,K)-CC(1,2,K) 32 TR3 = CC(1,2,K)+CC(1,4,K) 33 CH(1,K,1) = TR2+TR3 34 CH(1,K,3) = TR2-TR3 35 CH(2,K,1) = TI2+TI3 36 CH(2,K,3) = TI2-TI3 37 CH(1,K,2) = TR1+TR4 38 CH(1,K,4) = TR1-TR4 39 CH(2,K,2) = TI1+TI4 40 CH(2,K,4) = TI1-TI4 41 101 CONTINUE 42 RETURN 43 102 IF(IDO/2.LT.L1) GO TO 105 44 DO 104 K=1,L1 45CDIR$ IVDEP 46 DO 103 I=2,IDO,2 47 TI1 = CC(I,1,K)-CC(I,3,K) 48 TI2 = CC(I,1,K)+CC(I,3,K) 49 TI3 = CC(I,2,K)+CC(I,4,K) 50 TR4 = CC(I,2,K)-CC(I,4,K) 51 TR1 = CC(I-1,1,K)-CC(I-1,3,K) 52 TR2 = CC(I-1,1,K)+CC(I-1,3,K) 53 TI4 = CC(I-1,4,K)-CC(I-1,2,K) 54 TR3 = CC(I-1,2,K)+CC(I-1,4,K) 55 CH(I-1,K,1) = TR2+TR3 56 CR3 = TR2-TR3 57 CH(I,K,1) = TI2+TI3 58 CI3 = TI2-TI3 59 CR2 = TR1+TR4 60 CR4 = TR1-TR4 61 CI2 = TI1+TI4 62 CI4 = TI1-TI4 63 CH(I-1,K,2) = WA1(I-1)*CR2+WA1(I)*CI2 64 CH(I,K,2) = WA1(I-1)*CI2-WA1(I)*CR2 65 CH(I-1,K,3) = WA2(I-1)*CR3+WA2(I)*CI3 66 CH(I,K,3) = WA2(I-1)*CI3-WA2(I)*CR3 67 CH(I-1,K,4) = WA3(I-1)*CR4+WA3(I)*CI4 68 CH(I,K,4) = WA3(I-1)*CI4-WA3(I)*CR4 69 103 CONTINUE 70 104 CONTINUE 71 RETURN 72 105 DO 107 I=2,IDO,2 73CDIR$ IVDEP 74 DO 106 K=1,L1 75 TI1 = CC(I,1,K)-CC(I,3,K) 76 TI2 = CC(I,1,K)+CC(I,3,K) 77 TI3 = CC(I,2,K)+CC(I,4,K) 78 TR4 = CC(I,2,K)-CC(I,4,K) 79 TR1 = CC(I-1,1,K)-CC(I-1,3,K) 80 TR2 = CC(I-1,1,K)+CC(I-1,3,K) 81 TI4 = CC(I-1,4,K)-CC(I-1,2,K) 82 TR3 = CC(I-1,2,K)+CC(I-1,4,K) 83 CH(I-1,K,1) = TR2+TR3 84 CR3 = TR2-TR3 85 CH(I,K,1) = TI2+TI3 86 CI3 = TI2-TI3 87 CR2 = TR1+TR4 88 CR4 = TR1-TR4 89 CI2 = TI1+TI4 90 CI4 = TI1-TI4 91 CH(I-1,K,2) = WA1(I-1)*CR2+WA1(I)*CI2 92 CH(I,K,2) = WA1(I-1)*CI2-WA1(I)*CR2 93 CH(I-1,K,3) = WA2(I-1)*CR3+WA2(I)*CI3 94 CH(I,K,3) = WA2(I-1)*CI3-WA2(I)*CR3 95 CH(I-1,K,4) = WA3(I-1)*CR4+WA3(I)*CI4 96 CH(I,K,4) = WA3(I-1)*CI4-WA3(I)*CR4 97 106 CONTINUE 98 107 CONTINUE 99 RETURN 100 END 101