| 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: mrftf1.f,v 1.2 2004/06/15 21:29:20 rodney Exp $ |
|---|
| 11 | ! |
|---|
| 12 | !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC |
|---|
| 13 | |
|---|
| 14 | SUBROUTINE MRFTF1 (M,IM,N,IN,C,CH,WA,FAC) |
|---|
| 15 | REAL CH(M,*) ,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 MRADF4 (M,IDO,L1,C,IM,IN,CH,1,M,WA(IW),WA(IX2),WA(IX3)) |
|---|
| 34 | GO TO 110 |
|---|
| 35 | 101 CALL MRADF4 (M,IDO,L1,CH,1,M,C,IM,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 MRADF2 (M,IDO,L1,C,IM,IN,CH,1,M,WA(IW)) |
|---|
| 40 | GO TO 110 |
|---|
| 41 | 103 CALL MRADF2 (M,IDO,L1,CH,1,M,C,IM,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 MRADF3 (M,IDO,L1,C,IM,IN,CH,1,M,WA(IW),WA(IX2)) |
|---|
| 47 | GO TO 110 |
|---|
| 48 | 105 CALL MRADF3 (M,IDO,L1,CH,1,M,C,IM,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 MRADF5(M,IDO,L1,C,IM,IN,CH,1,M,WA(IW),WA(IX2), & |
|---|
| 56 | & WA(IX3),WA(IX4)) |
|---|
| 57 | GO TO 110 |
|---|
| 58 | 107 CALL MRADF5(M,IDO,L1,CH,1,M,C,IM,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 MRADFG (M,IDO,IP,L1,IDL1,C,C,C,IM,IN,CH,CH,1,M,WA(IW)) |
|---|
| 64 | NA = 1 |
|---|
| 65 | GO TO 110 |
|---|
| 66 | 109 CALL MRADFG (M,IDO,IP,L1,IDL1,CH,CH,CH,1,M,C,C,IM,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 | M2 = 1-IM |
|---|
| 78 | DO 117 I=1,M |
|---|
| 79 | M2 = M2+IM |
|---|
| 80 | C(M2,1) = SN*CH(I,1) |
|---|
| 81 | 117 END DO |
|---|
| 82 | DO 118 J=2,NL,2 |
|---|
| 83 | M2 = 1-IM |
|---|
| 84 | DO 118 I=1,M |
|---|
| 85 | M2 = M2+IM |
|---|
| 86 | C(M2,J) = TSN*CH(I,J) |
|---|
| 87 | C(M2,J+1) = TSNM*CH(I,J+1) |
|---|
| 88 | 118 CONTINUE |
|---|
| 89 | IF(MODN .NE. 0) RETURN |
|---|
| 90 | M2 = 1-IM |
|---|
| 91 | DO 119 I=1,M |
|---|
| 92 | M2 = M2+IM |
|---|
| 93 | C(M2,N) = SN*CH(I,N) |
|---|
| 94 | 119 END DO |
|---|
| 95 | RETURN |
|---|
| 96 | 120 M2 = 1-IM |
|---|
| 97 | DO 121 I=1,M |
|---|
| 98 | M2 = M2+IM |
|---|
| 99 | C(M2,1) = SN*C(M2,1) |
|---|
| 100 | 121 END DO |
|---|
| 101 | DO 122 J=2,NL,2 |
|---|
| 102 | M2 = 1-IM |
|---|
| 103 | DO 122 I=1,M |
|---|
| 104 | M2 = M2+IM |
|---|
| 105 | C(M2,J) = TSN*C(M2,J) |
|---|
| 106 | C(M2,J+1) = TSNM*C(M2,J+1) |
|---|
| 107 | 122 CONTINUE |
|---|
| 108 | IF(MODN .NE. 0) RETURN |
|---|
| 109 | M2 = 1-IM |
|---|
| 110 | DO 123 I=1,M |
|---|
| 111 | M2 = M2+IM |
|---|
| 112 | C(M2,N) = SN*C(M2,N) |
|---|
| 113 | 123 END DO |
|---|
| 114 | RETURN |
|---|
| 115 | END |
|---|
