source: lmdz_wrf/WRFV3/external/fftpack/fftpack5/r1fgkf.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: 6.2 KB
Line 
1!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2!                                                                       
3!   FFTPACK 5.0                                                         
4!                                                                       
5!   Authors:  Paul N. Swarztrauber and Richard A. Valent               
6!                                                                       
7!   $Id: r1fgkf.f,v 1.2 2004/06/15 21:29:20 rodney Exp $               
8!                                                                       
9!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10                                                                       
11      SUBROUTINE R1FGKF (IDO,IP,L1,IDL1,CC,C1,C2,IN1,                   &
12     &              CH,CH2,IN2,WA)                                     
13      REAL          CH(IN2,IDO,L1,IP)   ,CC(IN1,IDO,IP,L1),             &
14     &              C1(IN1,IDO,L1,IP)   ,C2(IN1,IDL1,IP),               &
15     &              CH2(IN2,IDL1,IP)    ,WA(IDO)                       
16!                                                                       
17      TPI=2.*4.*ATAN(1.0)
18      ARG = TPI/FLOAT(IP)
19      DCP = COS(ARG)
20      DSP = SIN(ARG)
21      IPPH = (IP+1)/2
22      IPP2 = IP+2
23      IDP2 = IDO+2
24      NBD = (IDO-1)/2
25      IF (IDO .EQ. 1) GO TO 119
26      DO 101 IK=1,IDL1
27         CH2(1,IK,1) = C2(1,IK,1)
28  101 END DO
29      DO 103 J=2,IP
30         DO 102 K=1,L1
31            CH(1,1,K,J) = C1(1,1,K,J)
32  102    CONTINUE
33  103 END DO
34      IF (NBD .GT. L1) GO TO 107
35      IS = -IDO
36      DO 106 J=2,IP
37         IS = IS+IDO
38         IDIJ = IS
39         DO 105 I=3,IDO,2
40            IDIJ = IDIJ+2
41            DO 104 K=1,L1
42               CH(1,I-1,K,J) = WA(IDIJ-1)*C1(1,I-1,K,J)+WA(IDIJ)        &
43     &           *C1(1,I,K,J)                                           
44               CH(1,I,K,J) = WA(IDIJ-1)*C1(1,I,K,J)-WA(IDIJ)            &
45     &           *C1(1,I-1,K,J)                                         
46  104       CONTINUE
47  105    CONTINUE
48  106 END DO
49      GO TO 111
50  107 IS = -IDO
51      DO 110 J=2,IP
52         IS = IS+IDO
53         DO 109 K=1,L1
54            IDIJ = IS
55            DO 108 I=3,IDO,2
56               IDIJ = IDIJ+2
57               CH(1,I-1,K,J) = WA(IDIJ-1)*C1(1,I-1,K,J)+WA(IDIJ)        &
58     &           *C1(1,I,K,J)                                           
59               CH(1,I,K,J) = WA(IDIJ-1)*C1(1,I,K,J)-WA(IDIJ)            &
60     &           *C1(1,I-1,K,J)                                         
61  108       CONTINUE
62  109    CONTINUE
63  110 END DO
64  111 IF (NBD .LT. L1) GO TO 115
65      DO 114 J=2,IPPH
66         JC = IPP2-J
67         DO 113 K=1,L1
68            DO 112 I=3,IDO,2
69               C1(1,I-1,K,J) = CH(1,I-1,K,J)+CH(1,I-1,K,JC)
70               C1(1,I-1,K,JC) = CH(1,I,K,J)-CH(1,I,K,JC)
71               C1(1,I,K,J) = CH(1,I,K,J)+CH(1,I,K,JC)
72               C1(1,I,K,JC) = CH(1,I-1,K,JC)-CH(1,I-1,K,J)
73  112       CONTINUE
74  113    CONTINUE
75  114 END DO
76      GO TO 121
77  115 DO 118 J=2,IPPH
78         JC = IPP2-J
79         DO 117 I=3,IDO,2
80            DO 116 K=1,L1
81               C1(1,I-1,K,J) = CH(1,I-1,K,J)+CH(1,I-1,K,JC)
82               C1(1,I-1,K,JC) = CH(1,I,K,J)-CH(1,I,K,JC)
83               C1(1,I,K,J) = CH(1,I,K,J)+CH(1,I,K,JC)
84               C1(1,I,K,JC) = CH(1,I-1,K,JC)-CH(1,I-1,K,J)
85  116       CONTINUE
86  117    CONTINUE
87  118 END DO
88      GO TO 121
89  119 DO 120 IK=1,IDL1
90         C2(1,IK,1) = CH2(1,IK,1)
91  120 END DO
92  121 DO 123 J=2,IPPH
93         JC = IPP2-J
94         DO 122 K=1,L1
95            C1(1,1,K,J) = CH(1,1,K,J)+CH(1,1,K,JC)
96            C1(1,1,K,JC) = CH(1,1,K,JC)-CH(1,1,K,J)
97  122    CONTINUE
98  123 END DO
99!                                                                       
100      AR1 = 1.
101      AI1 = 0.
102      DO 127 L=2,IPPH
103         LC = IPP2-L
104         AR1H = DCP*AR1-DSP*AI1
105         AI1 = DCP*AI1+DSP*AR1
106         AR1 = AR1H
107         DO 124 IK=1,IDL1
108            CH2(1,IK,L) = C2(1,IK,1)+AR1*C2(1,IK,2)
109            CH2(1,IK,LC) = AI1*C2(1,IK,IP)
110  124    CONTINUE
111         DC2 = AR1
112         DS2 = AI1
113         AR2 = AR1
114         AI2 = AI1
115         DO 126 J=3,IPPH
116            JC = IPP2-J
117            AR2H = DC2*AR2-DS2*AI2
118            AI2 = DC2*AI2+DS2*AR2
119            AR2 = AR2H
120            DO 125 IK=1,IDL1
121               CH2(1,IK,L) = CH2(1,IK,L)+AR2*C2(1,IK,J)
122               CH2(1,IK,LC) = CH2(1,IK,LC)+AI2*C2(1,IK,JC)
123  125       CONTINUE
124  126    CONTINUE
125  127 END DO
126      DO 129 J=2,IPPH
127         DO 128 IK=1,IDL1
128            CH2(1,IK,1) = CH2(1,IK,1)+C2(1,IK,J)
129  128    CONTINUE
130  129 END DO
131!                                                                       
132      IF (IDO .LT. L1) GO TO 132
133      DO 131 K=1,L1
134         DO 130 I=1,IDO
135            CC(1,I,1,K) = CH(1,I,K,1)
136  130    CONTINUE
137  131 END DO
138      GO TO 135
139  132 DO 134 I=1,IDO
140         DO 133 K=1,L1
141            CC(1,I,1,K) = CH(1,I,K,1)
142  133    CONTINUE
143  134 END DO
144  135 DO 137 J=2,IPPH
145         JC = IPP2-J
146         J2 = J+J
147         DO 136 K=1,L1
148            CC(1,IDO,J2-2,K) = CH(1,1,K,J)
149            CC(1,1,J2-1,K) = CH(1,1,K,JC)
150  136    CONTINUE
151  137 END DO
152      IF (IDO .EQ. 1) RETURN
153      IF (NBD .LT. L1) GO TO 141
154      DO 140 J=2,IPPH
155         JC = IPP2-J
156         J2 = J+J
157         DO 139 K=1,L1
158            DO 138 I=3,IDO,2
159               IC = IDP2-I
160               CC(1,I-1,J2-1,K) = CH(1,I-1,K,J)+CH(1,I-1,K,JC)
161               CC(1,IC-1,J2-2,K) = CH(1,I-1,K,J)-CH(1,I-1,K,JC)
162               CC(1,I,J2-1,K) = CH(1,I,K,J)+CH(1,I,K,JC)
163               CC(1,IC,J2-2,K) = CH(1,I,K,JC)-CH(1,I,K,J)
164  138       CONTINUE
165  139    CONTINUE
166  140 END DO
167      RETURN
168  141 DO 144 J=2,IPPH
169         JC = IPP2-J
170         J2 = J+J
171         DO 143 I=3,IDO,2
172            IC = IDP2-I
173            DO 142 K=1,L1
174               CC(1,I-1,J2-1,K) = CH(1,I-1,K,J)+CH(1,I-1,K,JC)
175               CC(1,IC-1,J2-2,K) = CH(1,I-1,K,J)-CH(1,I-1,K,JC)
176               CC(1,I,J2-1,K) = CH(1,I,K,J)+CH(1,I,K,JC)
177               CC(1,IC,J2-2,K) = CH(1,I,K,JC)-CH(1,I,K,J)
178  142       CONTINUE
179  143    CONTINUE
180  144 END DO
181      RETURN
182      END                                           
Note: See TracBrowser for help on using the repository browser.