source: trunk/WRF.COMMON/WRFV3/external/fftpack/fftpack5/cmfgkb.F @ 3567

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