source: lmdz_wrf/WRFV3/external/fftpack/fftpack5/r1f5kb.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: 7.5 KB
Line 
1!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2!                                                                       
3!   FFTPACK 5.0                                                         
4!                                                                       
5!   Authors:  Paul N. Swarztrauber and Richard A. Valent               
6!                                                                       
7!   $Id: r1f5kb.f,v 1.2 2004/06/15 21:29:20 rodney Exp $               
8!                                                                       
9!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10                                                                       
11      SUBROUTINE R1F5KB (IDO,L1,CC,IN1,CH,IN2,                          &
12     &       WA1,WA2,WA3,WA4)                                           
13      REAL   CC(IN1,IDO,5,L1)    ,CH(IN2,IDO,L1,5),                     &
14     &       WA1(IDO)     ,WA2(IDO)     ,WA3(IDO)     ,WA4(IDO)         
15!                                                                       
16      ARG=2.*4.*ATAN(1.0)/5.
17      TR11=COS(ARG)
18      TI11=SIN(ARG)
19      TR12=COS(2.*ARG)
20      TI12=SIN(2.*ARG)
21      DO 101 K=1,L1
22         CH(1,1,K,1) = CC(1,1,1,K)+2.*CC(1,IDO,2,K)+2.*CC(1,IDO,4,K)
23         CH(1,1,K,2) = (CC(1,1,1,K)+TR11*2.*CC(1,IDO,2,K)               &
24     &   +TR12*2.*CC(1,IDO,4,K))-(TI11*2.*CC(1,1,3,K)                   &
25     &   +TI12*2.*CC(1,1,5,K))                                         
26         CH(1,1,K,3) = (CC(1,1,1,K)+TR12*2.*CC(1,IDO,2,K)               &
27     &   +TR11*2.*CC(1,IDO,4,K))-(TI12*2.*CC(1,1,3,K)                   &
28     &   -TI11*2.*CC(1,1,5,K))                                         
29         CH(1,1,K,4) = (CC(1,1,1,K)+TR12*2.*CC(1,IDO,2,K)               &
30     &   +TR11*2.*CC(1,IDO,4,K))+(TI12*2.*CC(1,1,3,K)                   &
31     &   -TI11*2.*CC(1,1,5,K))                                         
32         CH(1,1,K,5) = (CC(1,1,1,K)+TR11*2.*CC(1,IDO,2,K)               &
33     &   +TR12*2.*CC(1,IDO,4,K))+(TI11*2.*CC(1,1,3,K)                   &
34     &   +TI12*2.*CC(1,1,5,K))                                         
35  101 END DO
36      IF (IDO .EQ. 1) RETURN
37      IDP2 = IDO+2
38      DO 103 K=1,L1
39         DO 102 I=3,IDO,2
40            IC = IDP2-I
41        CH(1,I-1,K,1) = CC(1,I-1,1,K)+(CC(1,I-1,3,K)+CC(1,IC-1,2,K))    &
42     &  +(CC(1,I-1,5,K)+CC(1,IC-1,4,K))                                 
43        CH(1,I,K,1) = CC(1,I,1,K)+(CC(1,I,3,K)-CC(1,IC,2,K))            &
44     &  +(CC(1,I,5,K)-CC(1,IC,4,K))                                     
45        CH(1,I-1,K,2) = WA1(I-2)*((CC(1,I-1,1,K)+TR11*                  &
46     &  (CC(1,I-1,3,K)+CC(1,IC-1,2,K))+TR12                             &
47     &  *(CC(1,I-1,5,K)+CC(1,IC-1,4,K)))-(TI11*(CC(1,I,3,K)             &
48     &  +CC(1,IC,2,K))+TI12*(CC(1,I,5,K)+CC(1,IC,4,K))))                &
49     &  -WA1(I-1)*((CC(1,I,1,K)+TR11*(CC(1,I,3,K)-CC(1,IC,2,K))         &
50     &  +TR12*(CC(1,I,5,K)-CC(1,IC,4,K)))+(TI11*(CC(1,I-1,3,K)          &
51     &  -CC(1,IC-1,2,K))+TI12*(CC(1,I-1,5,K)-CC(1,IC-1,4,K))))         
52        CH(1,I,K,2) = WA1(I-2)*((CC(1,I,1,K)+TR11*(CC(1,I,3,K)          &
53     &  -CC(1,IC,2,K))+TR12*(CC(1,I,5,K)-CC(1,IC,4,K)))                 &
54     &  +(TI11*(CC(1,I-1,3,K)-CC(1,IC-1,2,K))+TI12                      &
55     &  *(CC(1,I-1,5,K)-CC(1,IC-1,4,K))))+WA1(I-1)                      &
56     &  *((CC(1,I-1,1,K)+TR11*(CC(1,I-1,3,K)                            &
57     &  +CC(1,IC-1,2,K))+TR12*(CC(1,I-1,5,K)+CC(1,IC-1,4,K)))           &
58     &  -(TI11*(CC(1,I,3,K)+CC(1,IC,2,K))+TI12                          &
59     &  *(CC(1,I,5,K)+CC(1,IC,4,K))))                                   
60        CH(1,I-1,K,3) = WA2(I-2)                                        &
61     &  *((CC(1,I-1,1,K)+TR12*(CC(1,I-1,3,K)+CC(1,IC-1,2,K))            &
62     &  +TR11*(CC(1,I-1,5,K)+CC(1,IC-1,4,K)))-(TI12*(CC(1,I,3,K)        &
63     &  +CC(1,IC,2,K))-TI11*(CC(1,I,5,K)+CC(1,IC,4,K))))                &
64     & -WA2(I-1)                                                        &
65     & *((CC(1,I,1,K)+TR12*(CC(1,I,3,K)-                                &
66     &  CC(1,IC,2,K))+TR11*(CC(1,I,5,K)-CC(1,IC,4,K)))                  &
67     &  +(TI12*(CC(1,I-1,3,K)-CC(1,IC-1,2,K))-TI11                      &
68     &  *(CC(1,I-1,5,K)-CC(1,IC-1,4,K))))                               
69        CH(1,I,K,3) = WA2(I-2)                                          &
70     & *((CC(1,I,1,K)+TR12*(CC(1,I,3,K)-                                &
71     &  CC(1,IC,2,K))+TR11*(CC(1,I,5,K)-CC(1,IC,4,K)))                  &
72     &  +(TI12*(CC(1,I-1,3,K)-CC(1,IC-1,2,K))-TI11                      &
73     &  *(CC(1,I-1,5,K)-CC(1,IC-1,4,K))))                               &
74     &  +WA2(I-1)                                                       &
75     &  *((CC(1,I-1,1,K)+TR12*(CC(1,I-1,3,K)+CC(1,IC-1,2,K))            &
76     &  +TR11*(CC(1,I-1,5,K)+CC(1,IC-1,4,K)))-(TI12*(CC(1,I,3,K)        &
77     &  +CC(1,IC,2,K))-TI11*(CC(1,I,5,K)+CC(1,IC,4,K))))               
78        CH(1,I-1,K,4) = WA3(I-2)                                        &
79     &  *((CC(1,I-1,1,K)+TR12*(CC(1,I-1,3,K)+CC(1,IC-1,2,K))            &
80     &  +TR11*(CC(1,I-1,5,K)+CC(1,IC-1,4,K)))+(TI12*(CC(1,I,3,K)        &
81     &  +CC(1,IC,2,K))-TI11*(CC(1,I,5,K)+CC(1,IC,4,K))))                &
82     &  -WA3(I-1)                                                       &
83     & *((CC(1,I,1,K)+TR12*(CC(1,I,3,K)-                                &
84     &  CC(1,IC,2,K))+TR11*(CC(1,I,5,K)-CC(1,IC,4,K)))                  &
85     &  -(TI12*(CC(1,I-1,3,K)-CC(1,IC-1,2,K))-TI11                      &
86     &  *(CC(1,I-1,5,K)-CC(1,IC-1,4,K))))                               
87        CH(1,I,K,4) = WA3(I-2)                                          &
88     & *((CC(1,I,1,K)+TR12*(CC(1,I,3,K)-                                &
89     &  CC(1,IC,2,K))+TR11*(CC(1,I,5,K)-CC(1,IC,4,K)))                  &
90     &  -(TI12*(CC(1,I-1,3,K)-CC(1,IC-1,2,K))-TI11                      &
91     &  *(CC(1,I-1,5,K)-CC(1,IC-1,4,K))))                               &
92     &  +WA3(I-1)                                                       &
93     &  *((CC(1,I-1,1,K)+TR12*(CC(1,I-1,3,K)+CC(1,IC-1,2,K))            &
94     &  +TR11*(CC(1,I-1,5,K)+CC(1,IC-1,4,K)))+(TI12*(CC(1,I,3,K)        &
95     &  +CC(1,IC,2,K))-TI11*(CC(1,I,5,K)+CC(1,IC,4,K))))               
96        CH(1,I-1,K,5) = WA4(I-2)                                        &
97     &  *((CC(1,I-1,1,K)+TR11*(CC(1,I-1,3,K)+CC(1,IC-1,2,K))            &
98     &  +TR12*(CC(1,I-1,5,K)+CC(1,IC-1,4,K)))+(TI11*(CC(1,I,3,K)        &
99     &  +CC(1,IC,2,K))+TI12*(CC(1,I,5,K)+CC(1,IC,4,K))))                &
100     &  -WA4(I-1)                                                       &
101     &  *((CC(1,I,1,K)+TR11*(CC(1,I,3,K)-CC(1,IC,2,K))                  &
102     &  +TR12*(CC(1,I,5,K)-CC(1,IC,4,K)))-(TI11*(CC(1,I-1,3,K)          &
103     &  -CC(1,IC-1,2,K))+TI12*(CC(1,I-1,5,K)-CC(1,IC-1,4,K))))         
104        CH(1,I,K,5) = WA4(I-2)                                          &
105     &  *((CC(1,I,1,K)+TR11*(CC(1,I,3,K)-CC(1,IC,2,K))                  &
106     &  +TR12*(CC(1,I,5,K)-CC(1,IC,4,K)))-(TI11*(CC(1,I-1,3,K)          &
107     &  -CC(1,IC-1,2,K))+TI12*(CC(1,I-1,5,K)-CC(1,IC-1,4,K))))          &
108     &  +WA4(I-1)                                                       &
109     &  *((CC(1,I-1,1,K)+TR11*(CC(1,I-1,3,K)+CC(1,IC-1,2,K))            &
110     &  +TR12*(CC(1,I-1,5,K)+CC(1,IC-1,4,K)))+(TI11*(CC(1,I,3,K)        &
111     &  +CC(1,IC,2,K))+TI12*(CC(1,I,5,K)+CC(1,IC,4,K))))               
112  102    CONTINUE
113  103 END DO
114      RETURN
115      END                                           
Note: See TracBrowser for help on using the repository browser.