!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer,
! version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer
!version 3 or (at your option) any later version that should be found at:
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software;
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec),
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
!
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C FFTPACK 5.0
C Copyright (C) 1995-2004, Scientific Computing Division,
C University Corporation for Atmospheric Research
C Licensed under the GNU General Public License (GPL)
C
C Authors: Paul N. Swarztrauber and Richard A. Valent
C
C $Id: mrftb1_8.ftn,v 1.4 2011/11/29 15:45:00 armaanl Exp $
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE MRFTB1_8 (M,IM,N,IN,C,CH,WA,FAC) 1,10
#include "taglam4d.cdk"
REAL*8 CH(M,*), C(IN,*), WA(N) ,FAC(15)
real*8 HALF,HALFM
C
NF = FAC(2)
NA = 0
DO 10 K1=1,NF
IP = FAC(K1+2)
NA = 1-NA
IF(IP .LE. 5) GO TO 10
IF(K1 .EQ. NF) GO TO 10
NA = 1-NA
10 CONTINUE
HALF = .5
HALFM = -.5
MODN = MOD(N,2)
NL = N-2
IF(MODN .NE. 0) NL = N-1
IF (NA .EQ. 0) GO TO 120
M2 = 1-IM
DO 117 I=1,M
M2 = M2+IM
CH(I,1) = C(M2,1)
CH(I,N) = C(M2,N)
117 CONTINUE
DO 118 J=2,NL,2
M2 = 1-IM
DO 118 I=1,M
M2 = M2+IM
CH(I,J) = HALF*C(M2,J)
CH(I,J+1) = HALFM*C(M2,J+1)
118 CONTINUE
GO TO 124
120 continue
DO 122 J=2,NL,2
M2 = 1-IM
DO 122 I=1,M
M2 = M2+IM
C(M2,J) = HALF*C(M2,J)
C(M2,J+1) = HALFM*C(M2,J+1)
122 CONTINUE
124 L1 = 1
IW = 1
DO 116 K1=1,NF
IP = FAC(K1+2)
L2 = IP*L1
IDO = N/L2
IDL1 = IDO*L1
IF (IP .NE. 4) GO TO 103
IX2 = IW+IDO
IX3 = IX2+IDO
IF (NA .NE. 0) GO TO 101
CALL MRADB4_8 (M,IDO,L1,C,IM,IN,CH,1,M,WA(IW),WA(IX2),WA(IX3))
GO TO 102
101 CALL MRADB4_8 (M,IDO,L1,CH,1,M,C,IM,IN,WA(IW),WA(IX2),WA(IX3))
102 NA = 1-NA
GO TO 115
103 IF (IP .NE. 2) GO TO 106
IF (NA .NE. 0) GO TO 104
CALL MRADB2_8 (M,IDO,L1,C,IM,IN,CH,1,M,WA(IW))
GO TO 105
104 CALL MRADB2_8 (M,IDO,L1,CH,1,M,C,IM,IN,WA(IW))
105 NA = 1-NA
GO TO 115
106 IF (IP .NE. 3) GO TO 109
IX2 = IW+IDO
IF (NA .NE. 0) GO TO 107
CALL MRADB3_8 (M,IDO,L1,C,IM,IN,CH,1,M,WA(IW),WA(IX2))
GO TO 108
107 CALL MRADB3_8 (M,IDO,L1,CH,1,M,C,IM,IN,WA(IW),WA(IX2))
108 NA = 1-NA
GO TO 115
109 IF (IP .NE. 5) GO TO 112
IX2 = IW+IDO
IX3 = IX2+IDO
IX4 = IX3+IDO
IF (NA .NE. 0) GO TO 110
CALL MRADB5_8 (M,IDO,L1,C,IM,IN,CH,1,M,WA(IW),WA(IX2),
1 WA(IX3),WA(IX4))
GO TO 111
110 CALL MRADB5_8 (M,IDO,L1,CH,1,M,C,IM,IN,WA(IW),WA(IX2),
1 WA(IX3),WA(IX4))
111 NA = 1-NA
GO TO 115
112 IF (NA .NE. 0) GO TO 113
CALL MRADBG_8 (M,IDO,IP,L1,IDL1,C,C,C,IM,IN,CH,CH,1,
1 M,WA(IW))
GO TO 114
113 CALL MRADBG_8 (M,IDO,IP,L1,IDL1,CH,CH,CH,1,M,C,C,IM,
1 IN,WA(IW))
114 IF (IDO .EQ. 1) NA = 1-NA
115 L1 = L2
IW = IW+(IP-1)*IDO
116 CONTINUE
RETURN
END