1*DECK PASSF5 2 SUBROUTINE PASSF5 (IDO, L1, CC, CH, WA1, WA2, WA3, WA4) 3C***BEGIN PROLOGUE PASSF5 4C***SUBSIDIARY 5C***PURPOSE Calculate the fast Fourier transform of subvectors of 6C length five. 7C***LIBRARY SLATEC (FFTPACK) 8C***TYPE SINGLE PRECISION (PASSF5-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 PASSF5 24 DIMENSION CC(IDO,5,*), CH(IDO,L1,5), WA1(*), WA2(*), WA3(*), 25 + WA4(*) 26C***FIRST EXECUTABLE STATEMENT PASSF5 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 IF (IDO .NE. 2) GO TO 102 33 DO 101 K=1,L1 34 TI5 = CC(2,2,K)-CC(2,5,K) 35 TI2 = CC(2,2,K)+CC(2,5,K) 36 TI4 = CC(2,3,K)-CC(2,4,K) 37 TI3 = CC(2,3,K)+CC(2,4,K) 38 TR5 = CC(1,2,K)-CC(1,5,K) 39 TR2 = CC(1,2,K)+CC(1,5,K) 40 TR4 = CC(1,3,K)-CC(1,4,K) 41 TR3 = CC(1,3,K)+CC(1,4,K) 42 CH(1,K,1) = CC(1,1,K)+TR2+TR3 43 CH(2,K,1) = CC(2,1,K)+TI2+TI3 44 CR2 = CC(1,1,K)+TR11*TR2+TR12*TR3 45 CI2 = CC(2,1,K)+TR11*TI2+TR12*TI3 46 CR3 = CC(1,1,K)+TR12*TR2+TR11*TR3 47 CI3 = CC(2,1,K)+TR12*TI2+TR11*TI3 48 CR5 = TI11*TR5+TI12*TR4 49 CI5 = TI11*TI5+TI12*TI4 50 CR4 = TI12*TR5-TI11*TR4 51 CI4 = TI12*TI5-TI11*TI4 52 CH(1,K,2) = CR2-CI5 53 CH(1,K,5) = CR2+CI5 54 CH(2,K,2) = CI2+CR5 55 CH(2,K,3) = CI3+CR4 56 CH(1,K,3) = CR3-CI4 57 CH(1,K,4) = CR3+CI4 58 CH(2,K,4) = CI3-CR4 59 CH(2,K,5) = CI2-CR5 60 101 CONTINUE 61 RETURN 62 102 IF(IDO/2.LT.L1) GO TO 105 63 DO 104 K=1,L1 64CDIR$ IVDEP 65 DO 103 I=2,IDO,2 66 TI5 = CC(I,2,K)-CC(I,5,K) 67 TI2 = CC(I,2,K)+CC(I,5,K) 68 TI4 = CC(I,3,K)-CC(I,4,K) 69 TI3 = CC(I,3,K)+CC(I,4,K) 70 TR5 = CC(I-1,2,K)-CC(I-1,5,K) 71 TR2 = CC(I-1,2,K)+CC(I-1,5,K) 72 TR4 = CC(I-1,3,K)-CC(I-1,4,K) 73 TR3 = CC(I-1,3,K)+CC(I-1,4,K) 74 CH(I-1,K,1) = CC(I-1,1,K)+TR2+TR3 75 CH(I,K,1) = CC(I,1,K)+TI2+TI3 76 CR2 = CC(I-1,1,K)+TR11*TR2+TR12*TR3 77 CI2 = CC(I,1,K)+TR11*TI2+TR12*TI3 78 CR3 = CC(I-1,1,K)+TR12*TR2+TR11*TR3 79 CI3 = CC(I,1,K)+TR12*TI2+TR11*TI3 80 CR5 = TI11*TR5+TI12*TR4 81 CI5 = TI11*TI5+TI12*TI4 82 CR4 = TI12*TR5-TI11*TR4 83 CI4 = TI12*TI5-TI11*TI4 84 DR3 = CR3-CI4 85 DR4 = CR3+CI4 86 DI3 = CI3+CR4 87 DI4 = CI3-CR4 88 DR5 = CR2+CI5 89 DR2 = CR2-CI5 90 DI5 = CI2-CR5 91 DI2 = CI2+CR5 92 CH(I-1,K,2) = WA1(I-1)*DR2+WA1(I)*DI2 93 CH(I,K,2) = WA1(I-1)*DI2-WA1(I)*DR2 94 CH(I-1,K,3) = WA2(I-1)*DR3+WA2(I)*DI3 95 CH(I,K,3) = WA2(I-1)*DI3-WA2(I)*DR3 96 CH(I-1,K,4) = WA3(I-1)*DR4+WA3(I)*DI4 97 CH(I,K,4) = WA3(I-1)*DI4-WA3(I)*DR4 98 CH(I-1,K,5) = WA4(I-1)*DR5+WA4(I)*DI5 99 CH(I,K,5) = WA4(I-1)*DI5-WA4(I)*DR5 100 103 CONTINUE 101 104 CONTINUE 102 RETURN 103 105 DO 107 I=2,IDO,2 104CDIR$ IVDEP 105 DO 106 K=1,L1 106 TI5 = CC(I,2,K)-CC(I,5,K) 107 TI2 = CC(I,2,K)+CC(I,5,K) 108 TI4 = CC(I,3,K)-CC(I,4,K) 109 TI3 = CC(I,3,K)+CC(I,4,K) 110 TR5 = CC(I-1,2,K)-CC(I-1,5,K) 111 TR2 = CC(I-1,2,K)+CC(I-1,5,K) 112 TR4 = CC(I-1,3,K)-CC(I-1,4,K) 113 TR3 = CC(I-1,3,K)+CC(I-1,4,K) 114 CH(I-1,K,1) = CC(I-1,1,K)+TR2+TR3 115 CH(I,K,1) = CC(I,1,K)+TI2+TI3 116 CR2 = CC(I-1,1,K)+TR11*TR2+TR12*TR3 117 CI2 = CC(I,1,K)+TR11*TI2+TR12*TI3 118 CR3 = CC(I-1,1,K)+TR12*TR2+TR11*TR3 119 CI3 = CC(I,1,K)+TR12*TI2+TR11*TI3 120 CR5 = TI11*TR5+TI12*TR4 121 CI5 = TI11*TI5+TI12*TI4 122 CR4 = TI12*TR5-TI11*TR4 123 CI4 = TI12*TI5-TI11*TI4 124 DR3 = CR3-CI4 125 DR4 = CR3+CI4 126 DI3 = CI3+CR4 127 DI4 = CI3-CR4 128 DR5 = CR2+CI5 129 DR2 = CR2-CI5 130 DI5 = CI2-CR5 131 DI2 = CI2+CR5 132 CH(I-1,K,2) = WA1(I-1)*DR2+WA1(I)*DI2 133 CH(I,K,2) = WA1(I-1)*DI2-WA1(I)*DR2 134 CH(I-1,K,3) = WA2(I-1)*DR3+WA2(I)*DI3 135 CH(I,K,3) = WA2(I-1)*DI3-WA2(I)*DR3 136 CH(I-1,K,4) = WA3(I-1)*DR4+WA3(I)*DI4 137 CH(I,K,4) = WA3(I-1)*DI4-WA3(I)*DR4 138 CH(I-1,K,5) = WA4(I-1)*DR5+WA4(I)*DI5 139 CH(I,K,5) = WA4(I-1)*DI5-WA4(I)*DR5 140 106 CONTINUE 141 107 CONTINUE 142 RETURN 143 END 144