source: lmdz_wrf/WRFV3/external/fftpack/fftpack5/mrftf1.F @ 1

Last change on this file since 1 was 1, checked in by lfita, 10 years ago
  • -- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 3.7 KB
Line 
1!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2!                                                                       
3!   FFTPACK 5.0                                                         
4!                                                                       
5!   Authors:  Paul N. Swarztrauber and Richard A. Valent               
6!                                                                       
7!   $Id: mrftf1.f,v 1.2 2004/06/15 21:29:20 rodney Exp $               
8!                                                                       
9!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10                                                                       
11      SUBROUTINE MRFTF1 (M,IM,N,IN,C,CH,WA,FAC)
12      REAL       CH(M,*) ,C(IN,*)  ,WA(N)   ,FAC(15)
13!                                                                       
14      NF = FAC(2)
15      NA = 1
16      L2 = N
17      IW = N
18      DO 111 K1=1,NF
19         KH = NF-K1
20         IP = FAC(KH+3)
21         L1 = L2/IP
22         IDO = N/L2
23         IDL1 = IDO*L1
24         IW = IW-(IP-1)*IDO
25         NA = 1-NA
26         IF (IP .NE. 4) GO TO 102
27         IX2 = IW+IDO
28         IX3 = IX2+IDO
29         IF (NA .NE. 0) GO TO 101
30         CALL MRADF4 (M,IDO,L1,C,IM,IN,CH,1,M,WA(IW),WA(IX2),WA(IX3))
31         GO TO 110
32  101    CALL MRADF4 (M,IDO,L1,CH,1,M,C,IM,IN,WA(IW),WA(IX2),WA(IX3))
33         GO TO 110
34  102    IF (IP .NE. 2) GO TO 104
35         IF (NA .NE. 0) GO TO 103
36         CALL MRADF2 (M,IDO,L1,C,IM,IN,CH,1,M,WA(IW))
37         GO TO 110
38  103    CALL MRADF2 (M,IDO,L1,CH,1,M,C,IM,IN,WA(IW))
39         GO TO 110
40  104    IF (IP .NE. 3) GO TO 106
41         IX2 = IW+IDO
42         IF (NA .NE. 0) GO TO 105
43         CALL MRADF3 (M,IDO,L1,C,IM,IN,CH,1,M,WA(IW),WA(IX2))
44         GO TO 110
45  105    CALL MRADF3 (M,IDO,L1,CH,1,M,C,IM,IN,WA(IW),WA(IX2))
46         GO TO 110
47  106    IF (IP .NE. 5) GO TO 108
48         IX2 = IW+IDO
49         IX3 = IX2+IDO
50         IX4 = IX3+IDO
51         IF (NA .NE. 0) GO TO 107
52         CALL MRADF5(M,IDO,L1,C,IM,IN,CH,1,M,WA(IW),WA(IX2),            &
53     &                      WA(IX3),WA(IX4))                           
54         GO TO 110
55  107    CALL MRADF5(M,IDO,L1,CH,1,M,C,IM,IN,WA(IW),WA(IX2),            &
56     &                      WA(IX3),WA(IX4))                           
57         GO TO 110
58  108    IF (IDO .EQ. 1) NA = 1-NA
59         IF (NA .NE. 0) GO TO 109
60         CALL MRADFG (M,IDO,IP,L1,IDL1,C,C,C,IM,IN,CH,CH,1,M,WA(IW))
61         NA = 1
62         GO TO 110
63  109    CALL MRADFG (M,IDO,IP,L1,IDL1,CH,CH,CH,1,M,C,C,IM,IN,WA(IW))
64         NA = 0
65  110    L2 = L1
66  111 END DO
67      SN = 1./N
68      TSN = 2./N
69      TSNM = -TSN
70      MODN = MOD(N,2)
71      NL = N-2
72      IF(MODN .NE. 0) NL = N-1
73      IF (NA .NE. 0) GO TO 120
74      M2 = 1-IM
75      DO 117 I=1,M
76         M2 = M2+IM
77         C(M2,1) = SN*CH(I,1)
78  117 END DO
79      DO 118 J=2,NL,2
80      M2 = 1-IM
81      DO 118 I=1,M
82         M2 = M2+IM
83         C(M2,J) = TSN*CH(I,J)
84         C(M2,J+1) = TSNM*CH(I,J+1)
85  118 CONTINUE
86      IF(MODN .NE. 0) RETURN
87      M2 = 1-IM
88      DO 119 I=1,M
89         M2 = M2+IM
90         C(M2,N) = SN*CH(I,N)
91  119 END DO
92      RETURN
93  120 M2 = 1-IM
94      DO 121 I=1,M
95         M2 = M2+IM
96         C(M2,1) = SN*C(M2,1)
97  121 END DO
98      DO 122 J=2,NL,2
99      M2 = 1-IM
100      DO 122 I=1,M
101         M2 = M2+IM
102         C(M2,J) = TSN*C(M2,J)
103         C(M2,J+1) = TSNM*C(M2,J+1)
104  122 CONTINUE
105      IF(MODN .NE. 0) RETURN
106      M2 = 1-IM
107      DO 123 I=1,M
108         M2 = M2+IM
109         C(M2,N) = SN*C(M2,N)
110  123 END DO
111      RETURN
112      END                                           
Note: See TracBrowser for help on using the repository browser.