source: lmdz_wrf/trunk/WRFV3/external/fftpack/fftpack5/mradb4.F @ 565

Last change on this file since 565 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.5 KB
Line 
1!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2!                                                                       
3!   FFTPACK 5.0                                                         
4!                                                                       
5!   Authors:  Paul N. Swarztrauber and Richard A. Valent               
6!                                                                       
7!   $Id: mradb4.f,v 1.2 2004/06/15 21:29:19 rodney Exp $               
8!                                                                       
9!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10                                                                       
11      SUBROUTINE MRADB4 (M,IDO,L1,CC,IM1,IN1,CH,IM2,IN2,WA1,WA2,WA3)
12      REAL       CC(IN1,IDO,4,L1)  ,CH(IN2,IDO,L1,4)    ,               &
13     &           WA1(IDO)  ,        WA2(IDO)  ,       WA3(IDO)         
14!                                                                       
15      M1D = (M-1)*IM1+1
16      M2S = 1-IM2
17      SQRT2=SQRT(2.)
18      DO 101 K=1,L1
19          M2 = M2S
20          DO 1001 M1=1,M1D,IM1
21          M2 = M2+IM2
22         CH(M2,1,K,3) = (CC(M1,1,1,K)+CC(M1,IDO,4,K))                   &
23     &   -(CC(M1,IDO,2,K)+CC(M1,IDO,2,K))                               
24         CH(M2,1,K,1) = (CC(M1,1,1,K)+CC(M1,IDO,4,K))                   &
25     &   +(CC(M1,IDO,2,K)+CC(M1,IDO,2,K))                               
26         CH(M2,1,K,4) = (CC(M1,1,1,K)-CC(M1,IDO,4,K))                   &
27     &   +(CC(M1,1,3,K)+CC(M1,1,3,K))                                   
28         CH(M2,1,K,2) = (CC(M1,1,1,K)-CC(M1,IDO,4,K))                   &
29     &   -(CC(M1,1,3,K)+CC(M1,1,3,K))                                   
30 1001     CONTINUE
31  101 END DO
32      IF (IDO-2) 107,105,102
33  102 IDP2 = IDO+2
34      DO 104 K=1,L1
35         DO 103 I=3,IDO,2
36            IC = IDP2-I
37               M2 = M2S
38               DO 1002 M1=1,M1D,IM1
39               M2 = M2+IM2
40        CH(M2,I-1,K,1) = (CC(M1,I-1,1,K)+CC(M1,IC-1,4,K))               &
41     &  +(CC(M1,I-1,3,K)+CC(M1,IC-1,2,K))                               
42        CH(M2,I,K,1) = (CC(M1,I,1,K)-CC(M1,IC,4,K))                     &
43     &  +(CC(M1,I,3,K)-CC(M1,IC,2,K))                                   
44        CH(M2,I-1,K,2)=WA1(I-2)*((CC(M1,I-1,1,K)-CC(M1,IC-1,4,K))       &
45     &  -(CC(M1,I,3,K)+CC(M1,IC,2,K)))-WA1(I-1)                         &
46     &  *((CC(M1,I,1,K)+CC(M1,IC,4,K))+(CC(M1,I-1,3,K)-CC(M1,IC-1,2,K)))
47        CH(M2,I,K,2)=WA1(I-2)*((CC(M1,I,1,K)+CC(M1,IC,4,K))             &
48     &  +(CC(M1,I-1,3,K)-CC(M1,IC-1,2,K)))+WA1(I-1)                     &
49     &  *((CC(M1,I-1,1,K)-CC(M1,IC-1,4,K))-(CC(M1,I,3,K)+CC(M1,IC,2,K)))
50        CH(M2,I-1,K,3)=WA2(I-2)*((CC(M1,I-1,1,K)+CC(M1,IC-1,4,K))       &
51     &  -(CC(M1,I-1,3,K)+CC(M1,IC-1,2,K)))-WA2(I-1)                     &
52     &  *((CC(M1,I,1,K)-CC(M1,IC,4,K))-(CC(M1,I,3,K)-CC(M1,IC,2,K)))   
53        CH(M2,I,K,3)=WA2(I-2)*((CC(M1,I,1,K)-CC(M1,IC,4,K))             &
54     &  -(CC(M1,I,3,K)-CC(M1,IC,2,K)))+WA2(I-1)                         &
55     &  *((CC(M1,I-1,1,K)+CC(M1,IC-1,4,K))-(CC(M1,I-1,3,K)              &
56     &  +CC(M1,IC-1,2,K)))                                             
57        CH(M2,I-1,K,4)=WA3(I-2)*((CC(M1,I-1,1,K)-CC(M1,IC-1,4,K))       &
58     &  +(CC(M1,I,3,K)+CC(M1,IC,2,K)))-WA3(I-1)                         &
59     & *((CC(M1,I,1,K)+CC(M1,IC,4,K))-(CC(M1,I-1,3,K)-CC(M1,IC-1,2,K)))
60        CH(M2,I,K,4)=WA3(I-2)*((CC(M1,I,1,K)+CC(M1,IC,4,K))             &
61     &  -(CC(M1,I-1,3,K)-CC(M1,IC-1,2,K)))+WA3(I-1)                     &
62     &  *((CC(M1,I-1,1,K)-CC(M1,IC-1,4,K))+(CC(M1,I,3,K)+CC(M1,IC,2,K)))
63 1002          CONTINUE
64  103    CONTINUE
65  104 END DO
66      IF (MOD(IDO,2) .EQ. 1) RETURN
67  105 CONTINUE
68      DO 106 K=1,L1
69               M2 = M2S
70               DO 1003 M1=1,M1D,IM1
71               M2 = M2+IM2
72         CH(M2,IDO,K,1) = (CC(M1,IDO,1,K)+CC(M1,IDO,3,K))               &
73     &   +(CC(M1,IDO,1,K)+CC(M1,IDO,3,K))                               
74         CH(M2,IDO,K,2) = SQRT2*((CC(M1,IDO,1,K)-CC(M1,IDO,3,K))        &
75     &   -(CC(M1,1,2,K)+CC(M1,1,4,K)))                                 
76         CH(M2,IDO,K,3) = (CC(M1,1,4,K)-CC(M1,1,2,K))                   &
77     &   +(CC(M1,1,4,K)-CC(M1,1,2,K))                                   
78         CH(M2,IDO,K,4) = -SQRT2*((CC(M1,IDO,1,K)-CC(M1,IDO,3,K))       &
79     &   +(CC(M1,1,2,K)+CC(M1,1,4,K)))                                 
80 1003          CONTINUE
81  106 END DO
82  107 RETURN
83      END                                           
Note: See TracBrowser for help on using the repository browser.