1 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4 ! Copyright (C) 1995-2004, Scientific Computing Division,
5 ! University Corporation for Atmospheric Research
6 ! Licensed under the GNU General Public License (GPL)
8 ! Authors: Paul N. Swarztrauber and Richard A. Valent
10 ! $Id: mradbg.f,v 1.2 2004/06/15 21:29:20 rodney Exp $
12 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
14 SUBROUTINE MRADBG (M,IDO,IP,L1,IDL1,CC,C1,C2,IM1,IN1, &
16 REAL CH(IN2,IDO,L1,IP) ,CC(IN1,IDO,IP,L1) , &
17 & C1(IN1,IDO,L1,IP) ,C2(IN1,IDL1,IP), &
18 & CH2(IN2,IDL1,IP) ,WA(IDO)
30 IF (IDO .LT. L1) GO TO 103
36 CH(M2,I,K,1) = CC(M1,I,1,K)
46 CH(M2,I,K,1) = CC(M1,I,1,K)
57 CH(M2,1,K,J) = CC(M1,IDO,J2-2,K)+CC(M1,IDO,J2-2,K)
58 CH(M2,1,K,JC) = CC(M1,1,J2-1,K)+CC(M1,1,J2-1,K)
62 IF (IDO .EQ. 1) GO TO 116
63 IF (NBD .LT. L1) GO TO 112
72 CH(M2,I-1,K,J) = CC(M1,I-1,2*J-1,K)+CC(M1,IC-1,2*J-2,K)
73 CH(M2,I-1,K,JC) = CC(M1,I-1,2*J-1,K)-CC(M1,IC-1,2*J-2,K)
74 CH(M2,I,K,J) = CC(M1,I,2*J-1,K)-CC(M1,IC,2*J-2,K)
75 CH(M2,I,K,JC) = CC(M1,I,2*J-1,K)+CC(M1,IC,2*J-2,K)
89 CH(M2,I-1,K,J) = CC(M1,I-1,2*J-1,K)+CC(M1,IC-1,2*J-2,K)
90 CH(M2,I-1,K,JC) = CC(M1,I-1,2*J-1,K)-CC(M1,IC-1,2*J-2,K)
91 CH(M2,I,K,J) = CC(M1,I,2*J-1,K)-CC(M1,IC,2*J-2,K)
92 CH(M2,I,K,JC) = CC(M1,I,2*J-1,K)+CC(M1,IC,2*J-2,K)
101 AR1H = DCP*AR1-DSP*AI1
102 AI1 = DCP*AI1+DSP*AR1
108 C2(M1,IK,L) = CH2(M2,IK,1)+AR1*CH2(M2,IK,2)
109 C2(M1,IK,LC) = AI1*CH2(M2,IK,IP)
118 AR2H = DC2*AR2-DS2*AI2
119 AI2 = DC2*AI2+DS2*AR2
125 C2(M1,IK,L) = C2(M1,IK,L)+AR2*CH2(M2,IK,J)
126 C2(M1,IK,LC) = C2(M1,IK,LC)+AI2*CH2(M2,IK,JC)
136 CH2(M2,IK,1) = CH2(M2,IK,1)+CH2(M2,IK,J)
146 CH(M2,1,K,J) = C1(M1,1,K,J)-C1(M1,1,K,JC)
147 CH(M2,1,K,JC) = C1(M1,1,K,J)+C1(M1,1,K,JC)
151 IF (IDO .EQ. 1) GO TO 132
152 IF (NBD .LT. L1) GO TO 128
160 CH(M2,I-1,K,J) = C1(M1,I-1,K,J)-C1(M1,I,K,JC)
161 CH(M2,I-1,K,JC) = C1(M1,I-1,K,J)+C1(M1,I,K,JC)
162 CH(M2,I,K,J) = C1(M1,I,K,J)+C1(M1,I-1,K,JC)
163 CH(M2,I,K,JC) = C1(M1,I,K,J)-C1(M1,I-1,K,JC)
176 CH(M2,I-1,K,J) = C1(M1,I-1,K,J)-C1(M1,I,K,JC)
177 CH(M2,I-1,K,JC) = C1(M1,I-1,K,J)+C1(M1,I,K,JC)
178 CH(M2,I,K,J) = C1(M1,I,K,J)+C1(M1,I-1,K,JC)
179 CH(M2,I,K,JC) = C1(M1,I,K,J)-C1(M1,I-1,K,JC)
185 IF (IDO .EQ. 1) RETURN
190 C2(M1,IK,1) = CH2(M2,IK,1)
198 C1(M1,1,K,J) = CH(M2,1,K,J)
202 IF (NBD .GT. L1) GO TO 139
213 C1(M1,I-1,K,J) = WA(IDIJ-1)*CH(M2,I-1,K,J)-WA(IDIJ)* &
215 C1(M1,I,K,J) = WA(IDIJ-1)*CH(M2,I,K,J)+WA(IDIJ)* &
232 C1(M1,I-1,K,J) = WA(IDIJ-1)*CH(M2,I-1,K,J)-WA(IDIJ)* &
234 C1(M1,I,K,J) = WA(IDIJ-1)*CH(M2,I,K,J)+WA(IDIJ)* &