Context Navigation

r1f5kf.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: 8.3 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: r1f5kf.f,v 1.2 2004/06/15 21:29:20 rodney Exp $
11	!
12	!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
13
14	SUBROUTINE R1F5KF (IDO,L1,CC,IN1,CH,IN2, &
15	& WA1,WA2,WA3,WA4)
16	REAL CC(IN1,IDO,L1,5) ,CH(IN2,IDO,5,L1) , &
17	& WA1(IDO) ,WA2(IDO) ,WA3(IDO) ,WA4(IDO)
18	!
19	ARG=2.4.ATAN(1.0)/5.
20	TR11=COS(ARG)
21	TI11=SIN(ARG)
22	TR12=COS(2.*ARG)
23	TI12=SIN(2.*ARG)
24	DO 101 K=1,L1
25	CH(1,1,1,K) = CC(1,1,K,1)+(CC(1,1,K,5)+CC(1,1,K,2))+ &
26	& (CC(1,1,K,4)+CC(1,1,K,3))
27	CH(1,IDO,2,K) = CC(1,1,K,1)+TR11*(CC(1,1,K,5)+CC(1,1,K,2))+ &
28	& TR12*(CC(1,1,K,4)+CC(1,1,K,3))
29	CH(1,1,3,K) = TI11(CC(1,1,K,5)-CC(1,1,K,2))+TI12 &
30	& (CC(1,1,K,4)-CC(1,1,K,3))
31	CH(1,IDO,4,K) = CC(1,1,K,1)+TR12*(CC(1,1,K,5)+CC(1,1,K,2))+ &
32	& TR11*(CC(1,1,K,4)+CC(1,1,K,3))
33	CH(1,1,5,K) = TI12(CC(1,1,K,5)-CC(1,1,K,2))-TI11 &
34	& (CC(1,1,K,4)-CC(1,1,K,3))
35	101 END DO
36	IF (IDO .EQ. 1) RETURN
37	IDP2 = IDO+2
38	DO 103 K=1,L1
39	DO 102 I=3,IDO,2
40	IC = IDP2-I
41	CH(1,I-1,1,K) = CC(1,I-1,K,1)+((WA1(I-2)*CC(1,I-1,K,2)+ &
42	& WA1(I-1)CC(1,I,K,2))+(WA4(I-2)CC(1,I-1,K,5)+WA4(I-1)* &
43	& CC(1,I,K,5)))+((WA2(I-2)CC(1,I-1,K,3)+WA2(I-1) &
44	& CC(1,I,K,3))+(WA3(I-2)*CC(1,I-1,K,4)+ &
45	& WA3(I-1)*CC(1,I,K,4)))
46	CH(1,I,1,K) = CC(1,I,K,1)+((WA1(I-2)*CC(1,I,K,2)- &
47	& WA1(I-1)CC(1,I-1,K,2))+(WA4(I-2)CC(1,I,K,5)-WA4(I-1)* &
48	& CC(1,I-1,K,5)))+((WA2(I-2)CC(1,I,K,3)-WA2(I-1) &
49	& CC(1,I-1,K,3))+(WA3(I-2)CC(1,I,K,4)-WA3(I-1) &
50	& CC(1,I-1,K,4)))
51	CH(1,I-1,3,K) = CC(1,I-1,K,1)+TR11* &
52	& ( WA1(I-2)CC(1,I-1,K,2)+WA1(I-1)CC(1,I,K,2) &
53	& +WA4(I-2)CC(1,I-1,K,5)+WA4(I-1)CC(1,I,K,5))+TR12* &
54	& ( WA2(I-2)CC(1,I-1,K,3)+WA2(I-1)CC(1,I,K,3) &
55	& +WA3(I-2)CC(1,I-1,K,4)+WA3(I-1)CC(1,I,K,4))+TI11* &
56	& ( WA1(I-2)CC(1,I,K,2)-WA1(I-1)CC(1,I-1,K,2) &
57	& -(WA4(I-2)CC(1,I,K,5)-WA4(I-1)CC(1,I-1,K,5)))+TI12* &
58	& ( WA2(I-2)CC(1,I,K,3)-WA2(I-1)CC(1,I-1,K,3) &
59	& -(WA3(I-2)CC(1,I,K,4)-WA3(I-1)CC(1,I-1,K,4)))
60	CH(1,IC-1,2,K) = CC(1,I-1,K,1)+TR11* &
61	& ( WA1(I-2)CC(1,I-1,K,2)+WA1(I-1)CC(1,I,K,2) &
62	& +WA4(I-2)CC(1,I-1,K,5)+WA4(I-1)CC(1,I,K,5))+TR12* &
63	& ( WA2(I-2)CC(1,I-1,K,3)+WA2(I-1)CC(1,I,K,3) &
64	& +WA3(I-2)CC(1,I-1,K,4)+WA3(I-1)CC(1,I,K,4))-(TI11* &
65	& ( WA1(I-2)CC(1,I,K,2)-WA1(I-1)CC(1,I-1,K,2) &
66	& -(WA4(I-2)CC(1,I,K,5)-WA4(I-1)CC(1,I-1,K,5)))+TI12* &
67	& ( WA2(I-2)CC(1,I,K,3)-WA2(I-1)CC(1,I-1,K,3) &
68	& -(WA3(I-2)CC(1,I,K,4)-WA3(I-1)CC(1,I-1,K,4))))
69	CH(1,I,3,K) = (CC(1,I,K,1)+TR11((WA1(I-2)CC(1,I,K,2)- &
70	& WA1(I-1)CC(1,I-1,K,2))+(WA4(I-2)CC(1,I,K,5)-WA4(I-1)* &
71	& CC(1,I-1,K,5)))+TR12((WA2(I-2)CC(1,I,K,3)-WA2(I-1)* &
72	& CC(1,I-1,K,3))+(WA3(I-2)CC(1,I,K,4)-WA3(I-1) &
73	& CC(1,I-1,K,4))))+(TI11((WA4(I-2)CC(1,I-1,K,5)+ &
74	& WA4(I-1)CC(1,I,K,5))-(WA1(I-2)CC(1,I-1,K,2)+WA1(I-1)* &
75	& CC(1,I,K,2)))+TI12((WA3(I-2)CC(1,I-1,K,4)+WA3(I-1)* &
76	& CC(1,I,K,4))-(WA2(I-2)CC(1,I-1,K,3)+WA2(I-1) &
77	& CC(1,I,K,3))))
78	CH(1,IC,2,K) = (TI11((WA4(I-2)CC(1,I-1,K,5)+WA4(I-1)* &
79	& CC(1,I,K,5))-(WA1(I-2)CC(1,I-1,K,2)+WA1(I-1) &
80	& CC(1,I,K,2)))+TI12((WA3(I-2)CC(1,I-1,K,4)+WA3(I-1)* &
81	& CC(1,I,K,4))-(WA2(I-2)CC(1,I-1,K,3)+WA2(I-1) &
82	& CC(1,I,K,3))))-(CC(1,I,K,1)+TR11((WA1(I-2)CC(1,I,K,2)- &
83	& WA1(I-1)CC(1,I-1,K,2))+(WA4(I-2)CC(1,I,K,5)-WA4(I-1)* &
84	& CC(1,I-1,K,5)))+TR12((WA2(I-2)CC(1,I,K,3)-WA2(I-1)* &
85	& CC(1,I-1,K,3))+(WA3(I-2)CC(1,I,K,4)-WA3(I-1) &
86	& CC(1,I-1,K,4))))
87	CH(1,I-1,5,K) = (CC(1,I-1,K,1)+TR12((WA1(I-2) &
88	& CC(1,I-1,K,2)+WA1(I-1)CC(1,I,K,2))+(WA4(I-2) &
89	& CC(1,I-1,K,5)+WA4(I-1)CC(1,I,K,5)))+TR11((WA2(I-2)* &
90	& CC(1,I-1,K,3)+WA2(I-1)CC(1,I,K,3))+(WA3(I-2) &
91	& CC(1,I-1,K,4)+WA3(I-1)CC(1,I,K,4))))+(TI12((WA1(I-2)* &
92	& CC(1,I,K,2)-WA1(I-1)CC(1,I-1,K,2))-(WA4(I-2) &
93	& CC(1,I,K,5)-WA4(I-1)CC(1,I-1,K,5)))-TI11((WA2(I-2)* &
94	& CC(1,I,K,3)-WA2(I-1)CC(1,I-1,K,3))-(WA3(I-2) &
95	& CC(1,I,K,4)-WA3(I-1)*CC(1,I-1,K,4))))
96	CH(1,IC-1,4,K) = (CC(1,I-1,K,1)+TR12((WA1(I-2) &
97	& CC(1,I-1,K,2)+WA1(I-1)CC(1,I,K,2))+(WA4(I-2) &
98	& CC(1,I-1,K,5)+WA4(I-1)CC(1,I,K,5)))+TR11((WA2(I-2)* &
99	& CC(1,I-1,K,3)+WA2(I-1)CC(1,I,K,3))+(WA3(I-2) &
100	& CC(1,I-1,K,4)+WA3(I-1)CC(1,I,K,4))))-(TI12((WA1(I-2)* &
101	& CC(1,I,K,2)-WA1(I-1)CC(1,I-1,K,2))-(WA4(I-2) &
102	& CC(1,I,K,5)-WA4(I-1)CC(1,I-1,K,5)))-TI11((WA2(I-2)* &
103	& CC(1,I,K,3)-WA2(I-1)CC(1,I-1,K,3))-(WA3(I-2) &
104	& CC(1,I,K,4)-WA3(I-1)*CC(1,I-1,K,4))))
105	CH(1,I,5,K) = (CC(1,I,K,1)+TR12((WA1(I-2)CC(1,I,K,2)- &
106	& WA1(I-1)CC(1,I-1,K,2))+(WA4(I-2)CC(1,I,K,5)-WA4(I-1)* &
107	& CC(1,I-1,K,5)))+TR11((WA2(I-2)CC(1,I,K,3)-WA2(I-1)* &
108	& CC(1,I-1,K,3))+(WA3(I-2)CC(1,I,K,4)-WA3(I-1) &
109	& CC(1,I-1,K,4))))+(TI12((WA4(I-2)CC(1,I-1,K,5)+ &
110	& WA4(I-1)CC(1,I,K,5))-(WA1(I-2)CC(1,I-1,K,2)+WA1(I-1)* &
111	& CC(1,I,K,2)))-TI11((WA3(I-2)CC(1,I-1,K,4)+WA3(I-1)* &
112	& CC(1,I,K,4))-(WA2(I-2)CC(1,I-1,K,3)+WA2(I-1) &
113	& CC(1,I,K,3))))
114	CH(1,IC,4,K) = (TI12((WA4(I-2)CC(1,I-1,K,5)+WA4(I-1)* &
115	& CC(1,I,K,5))-(WA1(I-2)CC(1,I-1,K,2)+WA1(I-1) &
116	& CC(1,I,K,2)))-TI11((WA3(I-2)CC(1,I-1,K,4)+WA3(I-1)* &
117	& CC(1,I,K,4))-(WA2(I-2)CC(1,I-1,K,3)+WA2(I-1) &
118	& CC(1,I,K,3))))-(CC(1,I,K,1)+TR12((WA1(I-2)CC(1,I,K,2)- &
119	& WA1(I-1)CC(1,I-1,K,2))+(WA4(I-2)CC(1,I,K,5)-WA4(I-1)* &
120	& CC(1,I-1,K,5)))+TR11((WA2(I-2)CC(1,I,K,3)-WA2(I-1)* &
121	& CC(1,I-1,K,3))+(WA3(I-2)CC(1,I,K,4)-WA3(I-1) &
122	& CC(1,I-1,K,4))))
123	102 CONTINUE
124	103 END DO
125	RETURN
126	END

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

Download in other formats:

Original Format