source: lmdz_wrf/WRFV3/external/fftpack/fftpack5/cmfgkb.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: 5.4 KB
RevLine 
[1]1!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2!                                                                       
3!   FFTPACK 5.0                                                         
4!                                                                       
5!   Authors:  Paul N. Swarztrauber and Richard A. Valent               
6!                                                                       
7!   $Id: cmfgkb.f,v 1.2 2004/06/15 21:08:32 rodney Exp $               
8!                                                                       
9!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10                                                                       
11      SUBROUTINE CMFGKB (LOT,IDO,IP,L1,LID,NA,CC,CC1,IM1,IN1,           &
12     &                                      CH,CH1,IM2,IN2,WA)         
13      REAL       CH(2,IN2,L1,IDO,IP) ,CC(2,IN1,L1,IP,IDO),              &
14     &                CC1(2,IN1,LID,IP)    ,CH1(2,IN2,LID,IP)  ,        &
15     &                WA(IDO,IP-1,2)                                   
16!                                                                       
17! FFTPACK 5.0 auxiliary routine                                         
18!                                                                       
19      M1D = (LOT-1)*IM1+1
20      M2S = 1-IM2
21      IPP2 = IP+2
22      IPPH = (IP+1)/2
23      DO 110 KI=1,LID
24         M2 = M2S
25         DO 110 M1=1,M1D,IM1
26         M2 = M2+IM2
27         CH1(1,M2,KI,1) = CC1(1,M1,KI,1)
28         CH1(2,M2,KI,1) = CC1(2,M1,KI,1)
29  110 CONTINUE
30      DO 111 J=2,IPPH
31         JC = IPP2-J
32         DO 112 KI=1,LID
33         M2 = M2S
34         DO 112 M1=1,M1D,IM1
35         M2 = M2+IM2
36            CH1(1,M2,KI,J) =  CC1(1,M1,KI,J)+CC1(1,M1,KI,JC)
37            CH1(1,M2,KI,JC) = CC1(1,M1,KI,J)-CC1(1,M1,KI,JC)
38            CH1(2,M2,KI,J) =  CC1(2,M1,KI,J)+CC1(2,M1,KI,JC)
39            CH1(2,M2,KI,JC) = CC1(2,M1,KI,J)-CC1(2,M1,KI,JC)
40  112    CONTINUE
41  111 END DO
42      DO 118 J=2,IPPH
43         DO 117 KI=1,LID
44         M2 = M2S
45         DO 117 M1=1,M1D,IM1
46         M2 = M2+IM2
47            CC1(1,M1,KI,1) = CC1(1,M1,KI,1)+CH1(1,M2,KI,J)
48            CC1(2,M1,KI,1) = CC1(2,M1,KI,1)+CH1(2,M2,KI,J)
49  117    CONTINUE
50  118 END DO
51      DO 116 L=2,IPPH
52         LC = IPP2-L
53         DO 113 KI=1,LID
54         M2 = M2S
55         DO 113 M1=1,M1D,IM1
56         M2 = M2+IM2
57            CC1(1,M1,KI,L) = CH1(1,M2,KI,1)+WA(1,L-1,1)*CH1(1,M2,KI,2)
58            CC1(1,M1,KI,LC) = WA(1,L-1,2)*CH1(1,M2,KI,IP)
59            CC1(2,M1,KI,L) = CH1(2,M2,KI,1)+WA(1,L-1,1)*CH1(2,M2,KI,2)
60            CC1(2,M1,KI,LC) = WA(1,L-1,2)*CH1(2,M2,KI,IP)
61  113    CONTINUE
62         DO 115 J=3,IPPH
63            JC = IPP2-J
64            IDLJ = MOD((L-1)*(J-1),IP)
65            WAR = WA(1,IDLJ,1)
66            WAI = WA(1,IDLJ,2)
67            DO 114 KI=1,LID
68               M2 = M2S
69               DO 114 M1=1,M1D,IM1
70               M2 = M2+IM2
71               CC1(1,M1,KI,L) = CC1(1,M1,KI,L)+WAR*CH1(1,M2,KI,J)
72               CC1(1,M1,KI,LC) = CC1(1,M1,KI,LC)+WAI*CH1(1,M2,KI,JC)
73               CC1(2,M1,KI,L) = CC1(2,M1,KI,L)+WAR*CH1(2,M2,KI,J)
74               CC1(2,M1,KI,LC) = CC1(2,M1,KI,LC)+WAI*CH1(2,M2,KI,JC)
75  114       CONTINUE
76  115    CONTINUE
77  116 END DO
78      IF(IDO.GT.1 .OR. NA.EQ.1) GO TO 136
79      DO 120 J=2,IPPH
80         JC = IPP2-J
81         DO 119 KI=1,LID
82         DO 119 M1=1,M1D,IM1
83            CHOLD1 = CC1(1,M1,KI,J)-CC1(2,M1,KI,JC)
84            CHOLD2 = CC1(1,M1,KI,J)+CC1(2,M1,KI,JC)
85            CC1(1,M1,KI,J) = CHOLD1
86            CC1(2,M1,KI,JC) = CC1(2,M1,KI,J)-CC1(1,M1,KI,JC)
87            CC1(2,M1,KI,J) = CC1(2,M1,KI,J)+CC1(1,M1,KI,JC)
88            CC1(1,M1,KI,JC) = CHOLD2
89  119    CONTINUE
90  120 END DO
91      RETURN
92  136 DO 137 KI=1,LID
93         M2 = M2S
94         DO 137 M1=1,M1D,IM1
95         M2 = M2+IM2
96         CH1(1,M2,KI,1) = CC1(1,M1,KI,1)
97         CH1(2,M2,KI,1) = CC1(2,M1,KI,1)
98  137 CONTINUE
99      DO 135 J=2,IPPH
100         JC = IPP2-J
101         DO 134 KI=1,LID
102         M2 = M2S
103         DO 134 M1=1,M1D,IM1
104         M2 = M2+IM2
105            CH1(1,M2,KI,J) = CC1(1,M1,KI,J)-CC1(2,M1,KI,JC)
106            CH1(1,M2,KI,JC) = CC1(1,M1,KI,J)+CC1(2,M1,KI,JC)
107            CH1(2,M2,KI,JC) = CC1(2,M1,KI,J)-CC1(1,M1,KI,JC)
108            CH1(2,M2,KI,J) = CC1(2,M1,KI,J)+CC1(1,M1,KI,JC)
109  134    CONTINUE
110  135 END DO
111      IF (IDO .EQ. 1) RETURN
112      DO 131 I=1,IDO
113         DO 130 K=1,L1
114         M2 = M2S
115         DO 130 M1=1,M1D,IM1
116         M2 = M2+IM2
117            CC(1,M1,K,1,I) = CH(1,M2,K,I,1)
118            CC(2,M1,K,1,I) = CH(2,M2,K,I,1)
119  130    CONTINUE
120  131 END DO
121      DO 123 J=2,IP
122         DO 122 K=1,L1
123         M2 = M2S
124         DO 122 M1=1,M1D,IM1
125         M2 = M2+IM2
126            CC(1,M1,K,J,1) = CH(1,M2,K,1,J)
127            CC(2,M1,K,J,1) = CH(2,M2,K,1,J)
128  122    CONTINUE
129  123 END DO
130      DO 126 J=2,IP
131         DO 125 I=2,IDO
132            DO 124 K=1,L1
133               M2 = M2S
134               DO 124 M1=1,M1D,IM1
135               M2 = M2+IM2
136               CC(1,M1,K,J,I) = WA(I,J-1,1)*CH(1,M2,K,I,J)              &
137     &                      -WA(I,J-1,2)*CH(2,M2,K,I,J)                 
138               CC(2,M1,K,J,I) = WA(I,J-1,1)*CH(2,M2,K,I,J)              &
139     &                      +WA(I,J-1,2)*CH(1,M2,K,I,J)                 
140  124       CONTINUE
141  125    CONTINUE
142  126 END DO
143      RETURN
144      END                                           
Note: See TracBrowser for help on using the repository browser.