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