source: lmdz_wrf/WRFV3/external/fftpack/fftpack5/r1f4kb.F @ 13

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