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

Rev	Line
[2759]	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