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