Context Navigation

mradb5.F

Last change on this file was 2759, checked in by aslmd, 2 years ago
adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size
File size: 7.9 KB

Line
1	!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2	!
3	! FFTPACK 5.0
4	! Copyright (C) 1995-2004, Scientific Computing Division,
5	! University Corporation for Atmospheric Research
6	! Licensed under the GNU General Public License (GPL)
7	!
8	! Authors: Paul N. Swarztrauber and Richard A. Valent
9	!
10	! $Id: mradb5.f,v 1.2 2004/06/15 21:29:20 rodney Exp $
11	!
12	!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
13
14	SUBROUTINE MRADB5 (M,IDO,L1,CC,IM1,IN1,CH,IM2,IN2, &
15	& WA1,WA2,WA3,WA4)
16	REAL CC(IN1,IDO,5,L1) ,CH(IN2,IDO,L1,5), &
17	& WA1(IDO) ,WA2(IDO) ,WA3(IDO) ,WA4(IDO)
18	!
19	M1D = (M-1)*IM1+1
20	M2S = 1-IM2
21	ARG=2.4.ATAN(1.0)/5.
22	TR11=COS(ARG)
23	TI11=SIN(ARG)
24	TR12=COS(2.*ARG)
25	TI12=SIN(2.*ARG)
26	DO 101 K=1,L1
27	M2 = M2S
28	DO 1001 M1=1,M1D,IM1
29	M2 = M2+IM2
30	CH(M2,1,K,1) = CC(M1,1,1,K)+2.CC(M1,IDO,2,K)+2.CC(M1,IDO,4,K)
31	CH(M2,1,K,2) = (CC(M1,1,1,K)+TR112.CC(M1,IDO,2,K) &
32	& +TR122.CC(M1,IDO,4,K))-(TI112.CC(M1,1,3,K) &
33	& +TI122.CC(M1,1,5,K))
34	CH(M2,1,K,3) = (CC(M1,1,1,K)+TR122.CC(M1,IDO,2,K) &
35	& +TR112.CC(M1,IDO,4,K))-(TI122.CC(M1,1,3,K) &
36	& -TI112.CC(M1,1,5,K))
37	CH(M2,1,K,4) = (CC(M1,1,1,K)+TR122.CC(M1,IDO,2,K) &
38	& +TR112.CC(M1,IDO,4,K))+(TI122.CC(M1,1,3,K) &
39	& -TI112.CC(M1,1,5,K))
40	CH(M2,1,K,5) = (CC(M1,1,1,K)+TR112.CC(M1,IDO,2,K) &
41	& +TR122.CC(M1,IDO,4,K))+(TI112.CC(M1,1,3,K) &
42	& +TI122.CC(M1,1,5,K))
43	1001 CONTINUE
44	101 END DO
45	IF (IDO .EQ. 1) RETURN
46	IDP2 = IDO+2
47	DO 103 K=1,L1
48	DO 102 I=3,IDO,2
49	IC = IDP2-I
50	M2 = M2S
51	DO 1002 M1=1,M1D,IM1
52	M2 = M2+IM2
53	CH(M2,I-1,K,1) = CC(M1,I-1,1,K)+(CC(M1,I-1,3,K)+CC(M1,IC-1,2,K))&
54	& +(CC(M1,I-1,5,K)+CC(M1,IC-1,4,K))
55	CH(M2,I,K,1) = CC(M1,I,1,K)+(CC(M1,I,3,K)-CC(M1,IC,2,K)) &
56	& +(CC(M1,I,5,K)-CC(M1,IC,4,K))
57	CH(M2,I-1,K,2) = WA1(I-2)((CC(M1,I-1,1,K)+TR11 &
58	& (CC(M1,I-1,3,K)+CC(M1,IC-1,2,K))+TR12 &
59	& (CC(M1,I-1,5,K)+CC(M1,IC-1,4,K)))-(TI11(CC(M1,I,3,K) &
60	& +CC(M1,IC,2,K))+TI12*(CC(M1,I,5,K)+CC(M1,IC,4,K)))) &
61	& -WA1(I-1)((CC(M1,I,1,K)+TR11(CC(M1,I,3,K)-CC(M1,IC,2,K)) &
62	& +TR12(CC(M1,I,5,K)-CC(M1,IC,4,K)))+(TI11(CC(M1,I-1,3,K) &
63	& -CC(M1,IC-1,2,K))+TI12*(CC(M1,I-1,5,K)-CC(M1,IC-1,4,K))))
64	CH(M2,I,K,2) = WA1(I-2)((CC(M1,I,1,K)+TR11(CC(M1,I,3,K) &
65	& -CC(M1,IC,2,K))+TR12*(CC(M1,I,5,K)-CC(M1,IC,4,K))) &
66	& +(TI11*(CC(M1,I-1,3,K)-CC(M1,IC-1,2,K))+TI12 &
67	& *(CC(M1,I-1,5,K)-CC(M1,IC-1,4,K))))+WA1(I-1) &
68	& ((CC(M1,I-1,1,K)+TR11(CC(M1,I-1,3,K) &
69	& +CC(M1,IC-1,2,K))+TR12*(CC(M1,I-1,5,K)+CC(M1,IC-1,4,K))) &
70	& -(TI11*(CC(M1,I,3,K)+CC(M1,IC,2,K))+TI12 &
71	& *(CC(M1,I,5,K)+CC(M1,IC,4,K))))
72	CH(M2,I-1,K,3) = WA2(I-2) &
73	& ((CC(M1,I-1,1,K)+TR12(CC(M1,I-1,3,K)+CC(M1,IC-1,2,K)) &
74	& +TR11(CC(M1,I-1,5,K)+CC(M1,IC-1,4,K)))-(TI12(CC(M1,I,3,K) &
75	& +CC(M1,IC,2,K))-TI11*(CC(M1,I,5,K)+CC(M1,IC,4,K)))) &
76	& -WA2(I-1) &
77	& ((CC(M1,I,1,K)+TR12(CC(M1,I,3,K)- &
78	& CC(M1,IC,2,K))+TR11*(CC(M1,I,5,K)-CC(M1,IC,4,K))) &
79	& +(TI12*(CC(M1,I-1,3,K)-CC(M1,IC-1,2,K))-TI11 &
80	& *(CC(M1,I-1,5,K)-CC(M1,IC-1,4,K))))
81	CH(M2,I,K,3) = WA2(I-2) &
82	& ((CC(M1,I,1,K)+TR12(CC(M1,I,3,K)- &
83	& CC(M1,IC,2,K))+TR11*(CC(M1,I,5,K)-CC(M1,IC,4,K))) &
84	& +(TI12*(CC(M1,I-1,3,K)-CC(M1,IC-1,2,K))-TI11 &
85	& *(CC(M1,I-1,5,K)-CC(M1,IC-1,4,K)))) &
86	& +WA2(I-1) &
87	& ((CC(M1,I-1,1,K)+TR12(CC(M1,I-1,3,K)+CC(M1,IC-1,2,K)) &
88	& +TR11(CC(M1,I-1,5,K)+CC(M1,IC-1,4,K)))-(TI12(CC(M1,I,3,K) &
89	& +CC(M1,IC,2,K))-TI11*(CC(M1,I,5,K)+CC(M1,IC,4,K))))
90	CH(M2,I-1,K,4) = WA3(I-2) &
91	& ((CC(M1,I-1,1,K)+TR12(CC(M1,I-1,3,K)+CC(M1,IC-1,2,K)) &
92	& +TR11(CC(M1,I-1,5,K)+CC(M1,IC-1,4,K)))+(TI12(CC(M1,I,3,K) &
93	& +CC(M1,IC,2,K))-TI11*(CC(M1,I,5,K)+CC(M1,IC,4,K)))) &
94	& -WA3(I-1) &
95	& ((CC(M1,I,1,K)+TR12(CC(M1,I,3,K)- &
96	& CC(M1,IC,2,K))+TR11*(CC(M1,I,5,K)-CC(M1,IC,4,K))) &
97	& -(TI12*(CC(M1,I-1,3,K)-CC(M1,IC-1,2,K))-TI11 &
98	& *(CC(M1,I-1,5,K)-CC(M1,IC-1,4,K))))
99	CH(M2,I,K,4) = WA3(I-2) &
100	& ((CC(M1,I,1,K)+TR12(CC(M1,I,3,K)- &
101	& CC(M1,IC,2,K))+TR11*(CC(M1,I,5,K)-CC(M1,IC,4,K))) &
102	& -(TI12*(CC(M1,I-1,3,K)-CC(M1,IC-1,2,K))-TI11 &
103	& *(CC(M1,I-1,5,K)-CC(M1,IC-1,4,K)))) &
104	& +WA3(I-1) &
105	& ((CC(M1,I-1,1,K)+TR12(CC(M1,I-1,3,K)+CC(M1,IC-1,2,K)) &
106	& +TR11(CC(M1,I-1,5,K)+CC(M1,IC-1,4,K)))+(TI12(CC(M1,I,3,K) &
107	& +CC(M1,IC,2,K))-TI11*(CC(M1,I,5,K)+CC(M1,IC,4,K))))
108	CH(M2,I-1,K,5) = WA4(I-2) &
109	& ((CC(M1,I-1,1,K)+TR11(CC(M1,I-1,3,K)+CC(M1,IC-1,2,K)) &
110	& +TR12(CC(M1,I-1,5,K)+CC(M1,IC-1,4,K)))+(TI11(CC(M1,I,3,K) &
111	& +CC(M1,IC,2,K))+TI12*(CC(M1,I,5,K)+CC(M1,IC,4,K)))) &
112	& -WA4(I-1) &
113	& ((CC(M1,I,1,K)+TR11(CC(M1,I,3,K)-CC(M1,IC,2,K)) &
114	& +TR12(CC(M1,I,5,K)-CC(M1,IC,4,K)))-(TI11(CC(M1,I-1,3,K) &
115	& -CC(M1,IC-1,2,K))+TI12*(CC(M1,I-1,5,K)-CC(M1,IC-1,4,K))))
116	CH(M2,I,K,5) = WA4(I-2) &
117	& ((CC(M1,I,1,K)+TR11(CC(M1,I,3,K)-CC(M1,IC,2,K)) &
118	& +TR12(CC(M1,I,5,K)-CC(M1,IC,4,K)))-(TI11(CC(M1,I-1,3,K) &
119	& -CC(M1,IC-1,2,K))+TI12*(CC(M1,I-1,5,K)-CC(M1,IC-1,4,K)))) &
120	& +WA4(I-1) &
121	& ((CC(M1,I-1,1,K)+TR11(CC(M1,I-1,3,K)+CC(M1,IC-1,2,K)) &
122	& +TR12(CC(M1,I-1,5,K)+CC(M1,IC-1,4,K)))+(TI11(CC(M1,I,3,K) &
123	& +CC(M1,IC,2,K))+TI12*(CC(M1,I,5,K)+CC(M1,IC,4,K))))
124	1002 CONTINUE
125	102 CONTINUE
126	103 END DO
127	RETURN
128	END

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format