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: mradfg.f,v 1.2 2006-11-21 01:10:18 haley Exp $
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

      SUBROUTINE DMRADFG(M,IDO,IP,L1,IDL1,CC,C1,C2,IM1,IN1,CH,CH2,IM2,
     +                   IN2,WA)
      DOUBLE PRECISION TPI
      DOUBLE PRECISION ARG
      DOUBLE PRECISION DCP
      DOUBLE PRECISION DSP
      DOUBLE PRECISION AR1
      DOUBLE PRECISION AI1
      DOUBLE PRECISION AR1H
      DOUBLE PRECISION DC2
      DOUBLE PRECISION DS2
      DOUBLE PRECISION AR2
      DOUBLE PRECISION AI2
      DOUBLE PRECISION AR2H
      DOUBLE PRECISION CH(IN2,IDO,L1,IP),CC(IN1,IDO,IP,L1),
     +                 C1(IN1,IDO,L1,IP),C2(IN1,IDL1,IP),
     +                 CH2(IN2,IDL1,IP),WA(IDO)
C
      M1D = (M-1)*IM1 + 1
      M2S = 1 - IM2
      TPI = 2.D0*4.D0*ATAN(1.0D0)
      ARG = TPI/DBLE(IP)
      DCP = COS(ARG)
      DSP = SIN(ARG)
      IPPH = (IP+1)/2
      IPP2 = IP + 2
      IDP2 = IDO + 2
      NBD = (IDO-1)/2
      IF (IDO.EQ.1) GO TO 119
      DO 101 IK = 1,IDL1
          M2 = M2S
          DO 1001 M1 = 1,M1D,IM1
              M2 = M2 + IM2
              CH2(M2,IK,1) = C2(M1,IK,1)
 1001     CONTINUE
  101 CONTINUE
      DO 103 J = 2,IP
          DO 102 K = 1,L1
              M2 = M2S
              DO 1002 M1 = 1,M1D,IM1
                  M2 = M2 + IM2
                  CH(M2,1,K,J) = C1(M1,1,K,J)
 1002         CONTINUE
  102     CONTINUE
  103 CONTINUE
      IF (NBD.GT.L1) GO TO 107
      IS = -IDO
      DO 106 J = 2,IP
          IS = IS + IDO
          IDIJ = IS
          DO 105 I = 3,IDO,2
              IDIJ = IDIJ + 2
              DO 104 K = 1,L1
                  M2 = M2S
                  DO 1004 M1 = 1,M1D,IM1
                      M2 = M2 + IM2
                      CH(M2,I-1,K,J) = WA(IDIJ-1)*C1(M1,I-1,K,J) +
     +                                 WA(IDIJ)*C1(M1,I,K,J)
                      CH(M2,I,K,J) = WA(IDIJ-1)*C1(M1,I,K,J) -
     +                               WA(IDIJ)*C1(M1,I-1,K,J)
 1004             CONTINUE
  104         CONTINUE
  105     CONTINUE
  106 CONTINUE
      GO TO 111
  107 IS = -IDO
      DO 110 J = 2,IP
          IS = IS + IDO
          DO 109 K = 1,L1
              IDIJ = IS
              DO 108 I = 3,IDO,2
                  IDIJ = IDIJ + 2
                  M2 = M2S
                  DO 1008 M1 = 1,M1D,IM1
                      M2 = M2 + IM2
                      CH(M2,I-1,K,J) = WA(IDIJ-1)*C1(M1,I-1,K,J) +
     +                                 WA(IDIJ)*C1(M1,I,K,J)
                      CH(M2,I,K,J) = WA(IDIJ-1)*C1(M1,I,K,J) -
     +                               WA(IDIJ)*C1(M1,I-1,K,J)
 1008             CONTINUE
  108         CONTINUE
  109     CONTINUE
  110 CONTINUE
  111 IF (NBD.LT.L1) GO TO 115
      DO 114 J = 2,IPPH
          JC = IPP2 - J
          DO 113 K = 1,L1
              DO 112 I = 3,IDO,2
                  M2 = M2S
                  DO 1012 M1 = 1,M1D,IM1
                      M2 = M2 + IM2
                      C1(M1,I-1,K,J) = CH(M2,I-1,K,J) + CH(M2,I-1,K,JC)
                      C1(M1,I-1,K,JC) = CH(M2,I,K,J) - CH(M2,I,K,JC)
                      C1(M1,I,K,J) = CH(M2,I,K,J) + CH(M2,I,K,JC)
                      C1(M1,I,K,JC) = CH(M2,I-1,K,JC) - CH(M2,I-1,K,J)
 1012             CONTINUE
  112         CONTINUE
  113     CONTINUE
  114 CONTINUE
      GO TO 121
  115 DO 118 J = 2,IPPH
          JC = IPP2 - J
          DO 117 I = 3,IDO,2
              DO 116 K = 1,L1
                  M2 = M2S
                  DO 1016 M1 = 1,M1D,IM1
                      M2 = M2 + IM2
                      C1(M1,I-1,K,J) = CH(M2,I-1,K,J) + CH(M2,I-1,K,JC)
                      C1(M1,I-1,K,JC) = CH(M2,I,K,J) - CH(M2,I,K,JC)
                      C1(M1,I,K,J) = CH(M2,I,K,J) + CH(M2,I,K,JC)
                      C1(M1,I,K,JC) = CH(M2,I-1,K,JC) - CH(M2,I-1,K,J)
 1016             CONTINUE
  116         CONTINUE
  117     CONTINUE
  118 CONTINUE
      GO TO 121
  119 DO 120 IK = 1,IDL1
          M2 = M2S
          DO 1020 M1 = 1,M1D,IM1
              M2 = M2 + IM2
              C2(M1,IK,1) = CH2(M2,IK,1)
 1020     CONTINUE
  120 CONTINUE
  121 DO 123 J = 2,IPPH
          JC = IPP2 - J
          DO 122 K = 1,L1
              M2 = M2S
              DO 1022 M1 = 1,M1D,IM1
                  M2 = M2 + IM2
                  C1(M1,1,K,J) = CH(M2,1,K,J) + CH(M2,1,K,JC)
                  C1(M1,1,K,JC) = CH(M2,1,K,JC) - CH(M2,1,K,J)
 1022         CONTINUE
  122     CONTINUE
  123 CONTINUE
C
      AR1 = 1.D0
      AI1 = 0.D0
      DO 127 L = 2,IPPH
          LC = IPP2 - L
          AR1H = DCP*AR1 - DSP*AI1
          AI1 = DCP*AI1 + DSP*AR1
          AR1 = AR1H
          DO 124 IK = 1,IDL1
              M2 = M2S
              DO 1024 M1 = 1,M1D,IM1
                  M2 = M2 + IM2
                  CH2(M2,IK,L) = C2(M1,IK,1) + AR1*C2(M1,IK,2)
                  CH2(M2,IK,LC) = AI1*C2(M1,IK,IP)
 1024         CONTINUE
  124     CONTINUE
          DC2 = AR1
          DS2 = AI1
          AR2 = AR1
          AI2 = AI1
          DO 126 J = 3,IPPH
              JC = IPP2 - J
              AR2H = DC2*AR2 - DS2*AI2
              AI2 = DC2*AI2 + DS2*AR2
              AR2 = AR2H
              DO 125 IK = 1,IDL1
                  M2 = M2S
                  DO 1025 M1 = 1,M1D,IM1
                      M2 = M2 + IM2
                      CH2(M2,IK,L) = CH2(M2,IK,L) + AR2*C2(M1,IK,J)
                      CH2(M2,IK,LC) = CH2(M2,IK,LC) + AI2*C2(M1,IK,JC)
 1025             CONTINUE
  125         CONTINUE
  126     CONTINUE
  127 CONTINUE
      DO 129 J = 2,IPPH
          DO 128 IK = 1,IDL1
              M2 = M2S
              DO 1028 M1 = 1,M1D,IM1
                  M2 = M2 + IM2
                  CH2(M2,IK,1) = CH2(M2,IK,1) + C2(M1,IK,J)
 1028         CONTINUE
  128     CONTINUE
  129 CONTINUE
C
      IF (IDO.LT.L1) GO TO 132
      DO 131 K = 1,L1
          DO 130 I = 1,IDO
              M2 = M2S
              DO 1030 M1 = 1,M1D,IM1
                  M2 = M2 + IM2
                  CC(M1,I,1,K) = CH(M2,I,K,1)
 1030         CONTINUE
  130     CONTINUE
  131 CONTINUE
      GO TO 135
  132 DO 134 I = 1,IDO
          DO 133 K = 1,L1
              M2 = M2S
              DO 1033 M1 = 1,M1D,IM1
                  M2 = M2 + IM2
                  CC(M1,I,1,K) = CH(M2,I,K,1)
 1033         CONTINUE
  133     CONTINUE
  134 CONTINUE
  135 DO 137 J = 2,IPPH
          JC = IPP2 - J
          J2 = J + J
          DO 136 K = 1,L1
              M2 = M2S
              DO 1036 M1 = 1,M1D,IM1
                  M2 = M2 + IM2
                  CC(M1,IDO,J2-2,K) = CH(M2,1,K,J)
                  CC(M1,1,J2-1,K) = CH(M2,1,K,JC)
 1036         CONTINUE
  136     CONTINUE
  137 CONTINUE
      IF (IDO.EQ.1) RETURN
      IF (NBD.LT.L1) GO TO 141
      DO 140 J = 2,IPPH
          JC = IPP2 - J
          J2 = J + J
          DO 139 K = 1,L1
              DO 138 I = 3,IDO,2
                  IC = IDP2 - I
                  M2 = M2S
                  DO 1038 M1 = 1,M1D,IM1
                      M2 = M2 + IM2
                      CC(M1,I-1,J2-1,K) = CH(M2,I-1,K,J) +
     +                                    CH(M2,I-1,K,JC)
                      CC(M1,IC-1,J2-2,K) = CH(M2,I-1,K,J) -
     +                                     CH(M2,I-1,K,JC)
                      CC(M1,I,J2-1,K) = CH(M2,I,K,J) + CH(M2,I,K,JC)
                      CC(M1,IC,J2-2,K) = CH(M2,I,K,JC) - CH(M2,I,K,J)
 1038             CONTINUE
  138         CONTINUE
  139     CONTINUE
  140 CONTINUE
      RETURN
  141 DO 144 J = 2,IPPH
          JC = IPP2 - J
          J2 = J + J
          DO 143 I = 3,IDO,2
              IC = IDP2 - I
              DO 142 K = 1,L1
                  M2 = M2S
                  DO 1042 M1 = 1,M1D,IM1
                      M2 = M2 + IM2
                      CC(M1,I-1,J2-1,K) = CH(M2,I-1,K,J) +
     +                                    CH(M2,I-1,K,JC)
                      CC(M1,IC-1,J2-2,K) = CH(M2,I-1,K,J) -
     +                                     CH(M2,I-1,K,JC)
                      CC(M1,I,J2-1,K) = CH(M2,I,K,J) + CH(M2,I,K,JC)
                      CC(M1,IC,J2-2,K) = CH(M2,I,K,JC) - CH(M2,I,K,J)
 1042             CONTINUE
  142         CONTINUE
  143     CONTINUE
  144 CONTINUE
      RETURN
      END
