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