source: trunk/WRF.COMMON/WRFV3/external/fftpack/fftpack5/mrftf1.F

Last change on this file was 2759, checked in by aslmd, 2 years ago

adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size
File size: 3.9 KB
Line 
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                                           
Note: See TracBrowser for help on using the repository browser.