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

      SUBROUTINE DR1FGKF(IDO,IP,L1,IDL1,CC,C1,C2,IN1,CH,CH2,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
      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
          CH2(1,IK,1) = C2(1,IK,1)
  101 CONTINUE
      DO 103 J = 2,IP
          DO 102 K = 1,L1
              CH(1,1,K,J) = C1(1,1,K,J)
  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
                  CH(1,I-1,K,J) = WA(IDIJ-1)*C1(1,I-1,K,J) +
     +                            WA(IDIJ)*C1(1,I,K,J)
                  CH(1,I,K,J) = WA(IDIJ-1)*C1(1,I,K,J) -
     +                          WA(IDIJ)*C1(1,I-1,K,J)
  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
                  CH(1,I-1,K,J) = WA(IDIJ-1)*C1(1,I-1,K,J) +
     +                            WA(IDIJ)*C1(1,I,K,J)
                  CH(1,I,K,J) = WA(IDIJ-1)*C1(1,I,K,J) -
     +                          WA(IDIJ)*C1(1,I-1,K,J)
  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
                  C1(1,I-1,K,J) = CH(1,I-1,K,J) + CH(1,I-1,K,JC)
                  C1(1,I-1,K,JC) = CH(1,I,K,J) - CH(1,I,K,JC)
                  C1(1,I,K,J) = CH(1,I,K,J) + CH(1,I,K,JC)
                  C1(1,I,K,JC) = CH(1,I-1,K,JC) - CH(1,I-1,K,J)
  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
                  C1(1,I-1,K,J) = CH(1,I-1,K,J) + CH(1,I-1,K,JC)
                  C1(1,I-1,K,JC) = CH(1,I,K,J) - CH(1,I,K,JC)
                  C1(1,I,K,J) = CH(1,I,K,J) + CH(1,I,K,JC)
                  C1(1,I,K,JC) = CH(1,I-1,K,JC) - CH(1,I-1,K,J)
  116         CONTINUE
  117     CONTINUE
  118 CONTINUE
      GO TO 121
  119 DO 120 IK = 1,IDL1
          C2(1,IK,1) = CH2(1,IK,1)
  120 CONTINUE
  121 DO 123 J = 2,IPPH
          JC = IPP2 - J
          DO 122 K = 1,L1
              C1(1,1,K,J) = CH(1,1,K,J) + CH(1,1,K,JC)
              C1(1,1,K,JC) = CH(1,1,K,JC) - CH(1,1,K,J)
  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
              CH2(1,IK,L) = C2(1,IK,1) + AR1*C2(1,IK,2)
              CH2(1,IK,LC) = AI1*C2(1,IK,IP)
  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
                  CH2(1,IK,L) = CH2(1,IK,L) + AR2*C2(1,IK,J)
                  CH2(1,IK,LC) = CH2(1,IK,LC) + AI2*C2(1,IK,JC)
  125         CONTINUE
  126     CONTINUE
  127 CONTINUE
      DO 129 J = 2,IPPH
          DO 128 IK = 1,IDL1
              CH2(1,IK,1) = CH2(1,IK,1) + C2(1,IK,J)
  128     CONTINUE
  129 CONTINUE
C
      IF (IDO.LT.L1) GO TO 132
      DO 131 K = 1,L1
          DO 130 I = 1,IDO
              CC(1,I,1,K) = CH(1,I,K,1)
  130     CONTINUE
  131 CONTINUE
      GO TO 135
  132 DO 134 I = 1,IDO
          DO 133 K = 1,L1
              CC(1,I,1,K) = CH(1,I,K,1)
  133     CONTINUE
  134 CONTINUE
  135 DO 137 J = 2,IPPH
          JC = IPP2 - J
          J2 = J + J
          DO 136 K = 1,L1
              CC(1,IDO,J2-2,K) = CH(1,1,K,J)
              CC(1,1,J2-1,K) = CH(1,1,K,JC)
  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
                  CC(1,I-1,J2-1,K) = CH(1,I-1,K,J) + CH(1,I-1,K,JC)
                  CC(1,IC-1,J2-2,K) = CH(1,I-1,K,J) - CH(1,I-1,K,JC)
                  CC(1,I,J2-1,K) = CH(1,I,K,J) + CH(1,I,K,JC)
                  CC(1,IC,J2-2,K) = CH(1,I,K,JC) - CH(1,I,K,J)
  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
                  CC(1,I-1,J2-1,K) = CH(1,I-1,K,J) + CH(1,I-1,K,JC)
                  CC(1,IC-1,J2-2,K) = CH(1,I-1,K,J) - CH(1,I-1,K,JC)
                  CC(1,I,J2-1,K) = CH(1,I,K,J) + CH(1,I,K,JC)
                  CC(1,IC,J2-2,K) = CH(1,I,K,JC) - CH(1,I,K,J)
  142         CONTINUE
  143     CONTINUE
  144 CONTINUE
      RETURN
      END
