source: lmdz_wrf/WRFV3/external/fftpack/fftpack5/c1fgkb.F @ 13

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

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 4.3 KB
RevLine 
[1]1!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2!                                                                       
3!   FFTPACK 5.0                                                         
4!                                                                       
5!   Authors:  Paul N. Swarztrauber and Richard A. Valent               
6!                                                                       
7!   $Id: c1fgkb.f,v 1.2 2004/06/15 21:08:32 rodney Exp $               
8!                                                                       
9!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10                                                                       
11      SUBROUTINE C1FGKB (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 .OR. NA.EQ.1) GO TO 136
62      DO 120 J=2,IPPH
63         JC = IPP2-J
64         DO 119 KI=1,LID
65            CHOLD1 = CC1(1,KI,J)-CC1(2,KI,JC)
66            CHOLD2 = CC1(1,KI,J)+CC1(2,KI,JC)
67            CC1(1,KI,J) = CHOLD1
68            CC1(2,KI,JC) = CC1(2,KI,J)-CC1(1,KI,JC)
69            CC1(2,KI,J) = CC1(2,KI,J)+CC1(1,KI,JC)
70            CC1(1,KI,JC) = CHOLD2
71  119    CONTINUE
72  120 END DO
73      RETURN
74  136 DO 137 KI=1,LID
75         CH1(1,KI,1) = CC1(1,KI,1)
76         CH1(2,KI,1) = CC1(2,KI,1)
77  137 END DO
78      DO 135 J=2,IPPH
79         JC = IPP2-J
80         DO 134 KI=1,LID
81            CH1(1,KI,J) = CC1(1,KI,J)-CC1(2,KI,JC)
82            CH1(1,KI,JC) = CC1(1,KI,J)+CC1(2,KI,JC)
83            CH1(2,KI,JC) = CC1(2,KI,J)-CC1(1,KI,JC)
84            CH1(2,KI,J) = CC1(2,KI,J)+CC1(1,KI,JC)
85  134    CONTINUE
86  135 END DO
87      IF (IDO .EQ. 1) RETURN
88      DO 131 I=1,IDO
89         DO 130 K=1,L1
90            CC(1,K,1,I) = CH(1,K,I,1)
91            CC(2,K,1,I) = CH(2,K,I,1)
92  130    CONTINUE
93  131 END DO
94      DO 123 J=2,IP
95         DO 122 K=1,L1
96            CC(1,K,J,1) = CH(1,K,1,J)
97            CC(2,K,J,1) = CH(2,K,1,J)
98  122    CONTINUE
99  123 END DO
100      DO 126 J=2,IP
101         DO 125 I=2,IDO
102            DO 124 K=1,L1
103               CC(1,K,J,I) = WA(I,J-1,1)*CH(1,K,I,J)                    &
104     &                      -WA(I,J-1,2)*CH(2,K,I,J)                   
105               CC(2,K,J,I) = WA(I,J-1,1)*CH(2,K,I,J)                    &
106     &                      +WA(I,J-1,2)*CH(1,K,I,J)                   
107  124       CONTINUE
108  125    CONTINUE
109  126 END DO
110      RETURN
111      END                                           
Note: See TracBrowser for help on using the repository browser.