source: lmdz_wrf/WRFV3/external/fftpack/fftpack5/mradb3.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: 3.8 KB
Line 
1!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2!                                                                       
3!   FFTPACK 5.0                                                         
4!                                                                       
5!   Authors:  Paul N. Swarztrauber and Richard A. Valent               
6!                                                                       
7!   $Id: mradb3.f,v 1.2 2004/06/15 21:29:19 rodney Exp $               
8!                                                                       
9!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10                                                                       
11      SUBROUTINE MRADB3 (M,IDO,L1,CC,IM1,IN1,CH,IM2,IN2,WA1,WA2)
12      REAL       CC(IN1,IDO,3,L1)    ,CH(IN2,IDO,L1,3),                 &
13     &           WA1(IDO)   ,WA2(IDO)                                   
14!                                                                       
15      M1D = (M-1)*IM1+1
16      M2S = 1-IM2
17      ARG=2.*4.*ATAN(1.0)/3.
18      TAUR=COS(ARG)
19      TAUI=SIN(ARG)
20      DO 101 K=1,L1
21          M2 = M2S
22          DO 1001 M1=1,M1D,IM1
23          M2 = M2+IM2
24         CH(M2,1,K,1) = CC(M1,1,1,K)+2.*CC(M1,IDO,2,K)
25         CH(M2,1,K,2) = CC(M1,1,1,K)+(2.*TAUR)*CC(M1,IDO,2,K)           &
26     &   -(2.*TAUI)*CC(M1,1,3,K)                                       
27         CH(M2,1,K,3) = CC(M1,1,1,K)+(2.*TAUR)*CC(M1,IDO,2,K)           &
28     &   +2.*TAUI*CC(M1,1,3,K)                                         
29 1001     CONTINUE
30  101 END DO
31      IF (IDO .EQ. 1) RETURN
32      IDP2 = IDO+2
33      DO 103 K=1,L1
34         DO 102 I=3,IDO,2
35            IC = IDP2-I
36               M2 = M2S
37               DO 1002 M1=1,M1D,IM1
38               M2 = M2+IM2
39        CH(M2,I-1,K,1) = CC(M1,I-1,1,K)+(CC(M1,I-1,3,K)+CC(M1,IC-1,2,K))
40        CH(M2,I,K,1) = CC(M1,I,1,K)+(CC(M1,I,3,K)-CC(M1,IC,2,K))
41        CH(M2,I-1,K,2) = WA1(I-2)*                                      &
42     & ((CC(M1,I-1,1,K)+TAUR*(CC(M1,I-1,3,K)+CC(M1,IC-1,2,K)))-         &
43     & (TAUI*(CC(M1,I,3,K)+CC(M1,IC,2,K))))                             &
44     &                   -WA1(I-1)*                                     &
45     & ((CC(M1,I,1,K)+TAUR*(CC(M1,I,3,K)-CC(M1,IC,2,K)))+               &
46     & (TAUI*(CC(M1,I-1,3,K)-CC(M1,IC-1,2,K))))                         
47            CH(M2,I,K,2) = WA1(I-2)*                                    &
48     & ((CC(M1,I,1,K)+TAUR*(CC(M1,I,3,K)-CC(M1,IC,2,K)))+               &
49     & (TAUI*(CC(M1,I-1,3,K)-CC(M1,IC-1,2,K))))                         &
50     &                  +WA1(I-1)*                                      &
51     & ((CC(M1,I-1,1,K)+TAUR*(CC(M1,I-1,3,K)+CC(M1,IC-1,2,K)))-         &
52     & (TAUI*(CC(M1,I,3,K)+CC(M1,IC,2,K))))                             
53              CH(M2,I-1,K,3) = WA2(I-2)*                                &
54     & ((CC(M1,I-1,1,K)+TAUR*(CC(M1,I-1,3,K)+CC(M1,IC-1,2,K)))+         &
55     & (TAUI*(CC(M1,I,3,K)+CC(M1,IC,2,K))))                             &
56     &   -WA2(I-1)*                                                     &
57     & ((CC(M1,I,1,K)+TAUR*(CC(M1,I,3,K)-CC(M1,IC,2,K)))-               &
58     & (TAUI*(CC(M1,I-1,3,K)-CC(M1,IC-1,2,K))))                         
59            CH(M2,I,K,3) = WA2(I-2)*                                    &
60     & ((CC(M1,I,1,K)+TAUR*(CC(M1,I,3,K)-CC(M1,IC,2,K)))-               &
61     & (TAUI*(CC(M1,I-1,3,K)-CC(M1,IC-1,2,K))))                         &
62     &                 +WA2(I-1)*                                       &
63     & ((CC(M1,I-1,1,K)+TAUR*(CC(M1,I-1,3,K)+CC(M1,IC-1,2,K)))+         &
64     & (TAUI*(CC(M1,I,3,K)+CC(M1,IC,2,K))))                             
65 1002          CONTINUE
66  102    CONTINUE
67  103 END DO
68      RETURN
69      END                                           
Note: See TracBrowser for help on using the repository browser.