| [2759] | 1 | !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC |
|---|
| 2 | ! |
|---|
| 3 | ! FFTPACK 5.0 |
|---|
| 4 | ! Copyright (C) 1995-2004, Scientific Computing Division, |
|---|
| 5 | ! University Corporation for Atmospheric Research |
|---|
| 6 | ! Licensed under the GNU General Public License (GPL) |
|---|
| 7 | ! |
|---|
| 8 | ! Authors: Paul N. Swarztrauber and Richard A. Valent |
|---|
| 9 | ! |
|---|
| 10 | ! $Id: rfftf1.f,v 1.2 2004/06/15 21:29:20 rodney Exp $ |
|---|
| 11 | ! |
|---|
| 12 | !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC |
|---|
| 13 | |
|---|
| 14 | SUBROUTINE RFFTF1 (N,IN,C,CH,WA,FAC) |
|---|
| 15 | REAL CH(*) ,C(IN,*) ,WA(N) ,FAC(15) |
|---|
| 16 | ! |
|---|
| 17 | NF = FAC(2) |
|---|
| 18 | NA = 1 |
|---|
| 19 | L2 = N |
|---|
| 20 | IW = N |
|---|
| 21 | DO 111 K1=1,NF |
|---|
| 22 | KH = NF-K1 |
|---|
| 23 | IP = FAC(KH+3) |
|---|
| 24 | L1 = L2/IP |
|---|
| 25 | IDO = N/L2 |
|---|
| 26 | IDL1 = IDO*L1 |
|---|
| 27 | IW = IW-(IP-1)*IDO |
|---|
| 28 | NA = 1-NA |
|---|
| 29 | IF (IP .NE. 4) GO TO 102 |
|---|
| 30 | IX2 = IW+IDO |
|---|
| 31 | IX3 = IX2+IDO |
|---|
| 32 | IF (NA .NE. 0) GO TO 101 |
|---|
| 33 | CALL R1F4KF (IDO,L1,C,IN,CH,1,WA(IW),WA(IX2),WA(IX3)) |
|---|
| 34 | GO TO 110 |
|---|
| 35 | 101 CALL R1F4KF (IDO,L1,CH,1,C,IN,WA(IW),WA(IX2),WA(IX3)) |
|---|
| 36 | GO TO 110 |
|---|
| 37 | 102 IF (IP .NE. 2) GO TO 104 |
|---|
| 38 | IF (NA .NE. 0) GO TO 103 |
|---|
| 39 | CALL R1F2KF (IDO,L1,C,IN,CH,1,WA(IW)) |
|---|
| 40 | GO TO 110 |
|---|
| 41 | 103 CALL R1F2KF (IDO,L1,CH,1,C,IN,WA(IW)) |
|---|
| 42 | GO TO 110 |
|---|
| 43 | 104 IF (IP .NE. 3) GO TO 106 |
|---|
| 44 | IX2 = IW+IDO |
|---|
| 45 | IF (NA .NE. 0) GO TO 105 |
|---|
| 46 | CALL R1F3KF (IDO,L1,C,IN,CH,1,WA(IW),WA(IX2)) |
|---|
| 47 | GO TO 110 |
|---|
| 48 | 105 CALL R1F3KF (IDO,L1,CH,1,C,IN,WA(IW),WA(IX2)) |
|---|
| 49 | GO TO 110 |
|---|
| 50 | 106 IF (IP .NE. 5) GO TO 108 |
|---|
| 51 | IX2 = IW+IDO |
|---|
| 52 | IX3 = IX2+IDO |
|---|
| 53 | IX4 = IX3+IDO |
|---|
| 54 | IF (NA .NE. 0) GO TO 107 |
|---|
| 55 | CALL R1F5KF (IDO,L1,C,IN,CH,1,WA(IW),WA(IX2), & |
|---|
| 56 | & WA(IX3),WA(IX4)) |
|---|
| 57 | GO TO 110 |
|---|
| 58 | 107 CALL R1F5KF (IDO,L1,CH,1,C,IN,WA(IW),WA(IX2), & |
|---|
| 59 | & WA(IX3),WA(IX4)) |
|---|
| 60 | GO TO 110 |
|---|
| 61 | 108 IF (IDO .EQ. 1) NA = 1-NA |
|---|
| 62 | IF (NA .NE. 0) GO TO 109 |
|---|
| 63 | CALL R1FGKF (IDO,IP,L1,IDL1,C,C,C,IN,CH,CH,1,WA(IW)) |
|---|
| 64 | NA = 1 |
|---|
| 65 | GO TO 110 |
|---|
| 66 | 109 CALL R1FGKF (IDO,IP,L1,IDL1,CH,CH,CH,1,C,C,IN,WA(IW)) |
|---|
| 67 | NA = 0 |
|---|
| 68 | 110 L2 = L1 |
|---|
| 69 | 111 END DO |
|---|
| 70 | SN = 1./N |
|---|
| 71 | TSN = 2./N |
|---|
| 72 | TSNM = -TSN |
|---|
| 73 | MODN = MOD(N,2) |
|---|
| 74 | NL = N-2 |
|---|
| 75 | IF(MODN .NE. 0) NL = N-1 |
|---|
| 76 | IF (NA .NE. 0) GO TO 120 |
|---|
| 77 | C(1,1) = SN*CH(1) |
|---|
| 78 | DO 118 J=2,NL,2 |
|---|
| 79 | C(1,J) = TSN*CH(J) |
|---|
| 80 | C(1,J+1) = TSNM*CH(J+1) |
|---|
| 81 | 118 END DO |
|---|
| 82 | IF(MODN .NE. 0) RETURN |
|---|
| 83 | C(1,N) = SN*CH(N) |
|---|
| 84 | RETURN |
|---|
| 85 | 120 C(1,1) = SN*C(1,1) |
|---|
| 86 | DO 122 J=2,NL,2 |
|---|
| 87 | C(1,J) = TSN*C(1,J) |
|---|
| 88 | C(1,J+1) = TSNM*C(1,J+1) |
|---|
| 89 | 122 END DO |
|---|
| 90 | IF(MODN .NE. 0) RETURN |
|---|
| 91 | C(1,N) = SN*C(1,N) |
|---|
| 92 | RETURN |
|---|
| 93 | END |
|---|
