Context Navigation

cmfgkf.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: 6.5 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: cmfgkf.f,v 1.2 2004/06/15 21:08:32 rodney Exp $
	11	!
	12	!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
	13
	14	SUBROUTINE CMFGKF (LOT,IDO,IP,L1,LID,NA,CC,CC1,IM1,IN1, &
	15	& CH,CH1,IM2,IN2,WA)
	16	REAL CH(2,IN2,L1,IDO,IP) ,CC(2,IN1,L1,IP,IDO), &
	17	& CC1(2,IN1,LID,IP) ,CH1(2,IN2,LID,IP) , &
	18	& WA(IDO,IP-1,2)
	19	!
	20	! FFTPACK 5.0 auxiliary routine
	21	!
	22	M1D = (LOT-1)*IM1+1
	23	M2S = 1-IM2
	24	IPP2 = IP+2
	25	IPPH = (IP+1)/2
	26	DO 110 KI=1,LID
	27	M2 = M2S
	28	DO 110 M1=1,M1D,IM1
	29	M2 = M2+IM2
	30	CH1(1,M2,KI,1) = CC1(1,M1,KI,1)
	31	CH1(2,M2,KI,1) = CC1(2,M1,KI,1)
	32	110 CONTINUE
	33	DO 111 J=2,IPPH
	34	JC = IPP2-J
	35	DO 112 KI=1,LID
	36	M2 = M2S
	37	DO 112 M1=1,M1D,IM1
	38	M2 = M2+IM2
	39	CH1(1,M2,KI,J) = CC1(1,M1,KI,J)+CC1(1,M1,KI,JC)
	40	CH1(1,M2,KI,JC) = CC1(1,M1,KI,J)-CC1(1,M1,KI,JC)
	41	CH1(2,M2,KI,J) = CC1(2,M1,KI,J)+CC1(2,M1,KI,JC)
	42	CH1(2,M2,KI,JC) = CC1(2,M1,KI,J)-CC1(2,M1,KI,JC)
	43	112 CONTINUE
	44	111 END DO
	45	DO 118 J=2,IPPH
	46	DO 117 KI=1,LID
	47	M2 = M2S
	48	DO 117 M1=1,M1D,IM1
	49	M2 = M2+IM2
	50	CC1(1,M1,KI,1) = CC1(1,M1,KI,1)+CH1(1,M2,KI,J)
	51	CC1(2,M1,KI,1) = CC1(2,M1,KI,1)+CH1(2,M2,KI,J)
	52	117 CONTINUE
	53	118 END DO
	54	DO 116 L=2,IPPH
	55	LC = IPP2-L
	56	DO 113 KI=1,LID
	57	M2 = M2S
	58	DO 113 M1=1,M1D,IM1
	59	M2 = M2+IM2
	60	CC1(1,M1,KI,L) = CH1(1,M2,KI,1)+WA(1,L-1,1)*CH1(1,M2,KI,2)
	61	CC1(1,M1,KI,LC) = -WA(1,L-1,2)*CH1(1,M2,KI,IP)
	62	CC1(2,M1,KI,L) = CH1(2,M2,KI,1)+WA(1,L-1,1)*CH1(2,M2,KI,2)
	63	CC1(2,M1,KI,LC) = -WA(1,L-1,2)*CH1(2,M2,KI,IP)
	64	113 CONTINUE
	65	DO 115 J=3,IPPH
	66	JC = IPP2-J
	67	IDLJ = MOD((L-1)*(J-1),IP)
	68	WAR = WA(1,IDLJ,1)
	69	WAI = -WA(1,IDLJ,2)
	70	DO 114 KI=1,LID
	71	M2 = M2S
	72	DO 114 M1=1,M1D,IM1
	73	M2 = M2+IM2
	74	CC1(1,M1,KI,L) = CC1(1,M1,KI,L)+WAR*CH1(1,M2,KI,J)
	75	CC1(1,M1,KI,LC) = CC1(1,M1,KI,LC)+WAI*CH1(1,M2,KI,JC)
	76	CC1(2,M1,KI,L) = CC1(2,M1,KI,L)+WAR*CH1(2,M2,KI,J)
	77	CC1(2,M1,KI,LC) = CC1(2,M1,KI,LC)+WAI*CH1(2,M2,KI,JC)
	78	114 CONTINUE
	79	115 CONTINUE
	80	116 END DO
	81	IF (IDO .GT. 1) GO TO 136
	82	SN = 1./REAL(IP*L1)
	83	IF (NA .EQ. 1) GO TO 146
	84	DO 149 KI=1,LID
	85	M2 = M2S
	86	DO 149 M1=1,M1D,IM1
	87	M2 = M2+IM2
	88	CC1(1,M1,KI,1) = SN*CC1(1,M1,KI,1)
	89	CC1(2,M1,KI,1) = SN*CC1(2,M1,KI,1)
	90	149 CONTINUE
	91	DO 120 J=2,IPPH
	92	JC = IPP2-J
	93	DO 119 KI=1,LID
	94	DO 119 M1=1,M1D,IM1
	95	CHOLD1 = SN*(CC1(1,M1,KI,J)-CC1(2,M1,KI,JC))
	96	CHOLD2 = SN*(CC1(1,M1,KI,J)+CC1(2,M1,KI,JC))
	97	CC1(1,M1,KI,J) = CHOLD1
	98	CC1(2,M1,KI,JC) = SN*(CC1(2,M1,KI,J)-CC1(1,M1,KI,JC))
	99	CC1(2,M1,KI,J) = SN*(CC1(2,M1,KI,J)+CC1(1,M1,KI,JC))
	100	CC1(1,M1,KI,JC) = CHOLD2
	101	119 CONTINUE
	102	120 END DO
	103	RETURN
	104	146 DO 147 KI=1,LID
	105	M2 = M2S
	106	DO 147 M1=1,M1D,IM1
	107	M2 = M2+IM2
	108	CH1(1,M2,KI,1) = SN*CC1(1,M1,KI,1)
	109	CH1(2,M2,KI,1) = SN*CC1(2,M1,KI,1)
	110	147 CONTINUE
	111	DO 145 J=2,IPPH
	112	JC = IPP2-J
	113	DO 144 KI=1,LID
	114	M2 = M2S
	115	DO 144 M1=1,M1D,IM1
	116	M2 = M2+IM2
	117	CH1(1,M2,KI,J) = SN*(CC1(1,M1,KI,J)-CC1(2,M1,KI,JC))
	118	CH1(2,M2,KI,J) = SN*(CC1(2,M1,KI,J)+CC1(1,M1,KI,JC))
	119	CH1(1,M2,KI,JC) = SN*(CC1(1,M1,KI,J)+CC1(2,M1,KI,JC))
	120	CH1(2,M2,KI,JC) = SN*(CC1(2,M1,KI,J)-CC1(1,M1,KI,JC))
	121	144 CONTINUE
	122	145 END DO
	123	RETURN
	124	136 DO 137 KI=1,LID
	125	M2 = M2S
	126	DO 137 M1=1,M1D,IM1
	127	M2 = M2+IM2
	128	CH1(1,M2,KI,1) = CC1(1,M1,KI,1)
	129	CH1(2,M2,KI,1) = CC1(2,M1,KI,1)
	130	137 CONTINUE
	131	DO 135 J=2,IPPH
	132	JC = IPP2-J
	133	DO 134 KI=1,LID
	134	M2 = M2S
	135	DO 134 M1=1,M1D,IM1
	136	M2 = M2+IM2
	137	CH1(1,M2,KI,J) = CC1(1,M1,KI,J)-CC1(2,M1,KI,JC)
	138	CH1(2,M2,KI,J) = CC1(2,M1,KI,J)+CC1(1,M1,KI,JC)
	139	CH1(1,M2,KI,JC) = CC1(1,M1,KI,J)+CC1(2,M1,KI,JC)
	140	CH1(2,M2,KI,JC) = CC1(2,M1,KI,J)-CC1(1,M1,KI,JC)
	141	134 CONTINUE
	142	135 END DO
	143	DO 131 I=1,IDO
	144	DO 130 K=1,L1
	145	M2 = M2S
	146	DO 130 M1=1,M1D,IM1
	147	M2 = M2+IM2
	148	CC(1,M1,K,1,I) = CH(1,M2,K,I,1)
	149	CC(2,M1,K,1,I) = CH(2,M2,K,I,1)
	150	130 CONTINUE
	151	131 END DO
	152	DO 123 J=2,IP
	153	DO 122 K=1,L1
	154	M2 = M2S
	155	DO 122 M1=1,M1D,IM1
	156	M2 = M2+IM2
	157	CC(1,M1,K,J,1) = CH(1,M2,K,1,J)
	158	CC(2,M1,K,J,1) = CH(2,M2,K,1,J)
	159	122 CONTINUE
	160	123 END DO
	161	DO 126 J=2,IP
	162	DO 125 I=2,IDO
	163	DO 124 K=1,L1
	164	M2 = M2S
	165	DO 124 M1=1,M1D,IM1
	166	M2 = M2+IM2
	167	CC(1,M1,K,J,I) = WA(I,J-1,1)*CH(1,M2,K,I,J) &
	168	& +WA(I,J-1,2)*CH(2,M2,K,I,J)
	169	CC(2,M1,K,J,I) = WA(I,J-1,1)*CH(2,M2,K,I,J) &
	170	& -WA(I,J-1,2)*CH(1,M2,K,I,J)
	171	124 CONTINUE
	172	125 CONTINUE
	173	126 END DO
	174	RETURN
	175	END

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

Download in other formats:

Original Format