source: lmdz_wrf/WRFV3/external/fftpack/fftpack5/cmf2kb.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: 2.2 KB
RevLine 
[1]1!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2!                                                                       
3!   FFTPACK 5.0                                                         
4!                                                                       
5!   Authors:  Paul N. Swarztrauber and Richard A. Valent               
6!                                                                       
7!   $Id: cmf2kb.f,v 1.2 2004/06/15 21:08:32 rodney Exp $               
8!                                                                       
9!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10                                                                       
11      SUBROUTINE CMF2KB (LOT,IDO,L1,NA,CC,IM1,IN1,CH,IM2,IN2,WA)
12      REAL  CC(2,IN1,L1,IDO,2),CH(2,IN2,L1,2,IDO),WA(IDO,1,2)
13!                                                                       
14      M1D = (LOT-1)*IM1+1
15      M2S = 1-IM2
16      IF (IDO.GT.1 .OR. NA.EQ.1) GO TO 102
17      DO 101 K=1,L1
18         DO 101 M1=1,M1D,IM1
19         CHOLD1 = CC(1,M1,K,1,1)+CC(1,M1,K,1,2)
20         CC(1,M1,K,1,2) = CC(1,M1,K,1,1)-CC(1,M1,K,1,2)
21         CC(1,M1,K,1,1) = CHOLD1
22         CHOLD2 = CC(2,M1,K,1,1)+CC(2,M1,K,1,2)
23         CC(2,M1,K,1,2) = CC(2,M1,K,1,1)-CC(2,M1,K,1,2)
24         CC(2,M1,K,1,1) = CHOLD2
25  101 CONTINUE
26      RETURN
27  102 DO 103 K=1,L1
28         M2 = M2S
29         DO 103 M1=1,M1D,IM1
30         M2 = M2+IM2
31         CH(1,M2,K,1,1) = CC(1,M1,K,1,1)+CC(1,M1,K,1,2)
32         CH(1,M2,K,2,1) = CC(1,M1,K,1,1)-CC(1,M1,K,1,2)
33         CH(2,M2,K,1,1) = CC(2,M1,K,1,1)+CC(2,M1,K,1,2)
34         CH(2,M2,K,2,1) = CC(2,M1,K,1,1)-CC(2,M1,K,1,2)
35  103 CONTINUE
36      IF(IDO .EQ. 1) RETURN
37      DO 105 I=2,IDO
38         DO 104 K=1,L1
39         M2 = M2S
40         DO 104 M1=1,M1D,IM1
41         M2 = M2+IM2
42            CH(1,M2,K,1,I) = CC(1,M1,K,I,1)+CC(1,M1,K,I,2)
43            TR2 = CC(1,M1,K,I,1)-CC(1,M1,K,I,2)
44            CH(2,M2,K,1,I) = CC(2,M1,K,I,1)+CC(2,M1,K,I,2)
45            TI2 = CC(2,M1,K,I,1)-CC(2,M1,K,I,2)
46            CH(2,M2,K,2,I) = WA(I,1,1)*TI2+WA(I,1,2)*TR2
47            CH(1,M2,K,2,I) = WA(I,1,1)*TR2-WA(I,1,2)*TI2
48  104    CONTINUE
49  105 END DO
50      RETURN
51      END                                           
Note: See TracBrowser for help on using the repository browser.