var/convertor/kma_wave2grid/RADFGM.inc

   1 C***********************************************************************
   2       SUBROUTINE RADFGM (INC,LOT,IDO,IP,L1,IDL1,CC,C1,C2,CH,CH2,WA)
   3       DIMENSION       CH(INC,IDO,L1,IP)        ,CC(INC,IDO,IP,L1)
   4      1               ,C1(INC,IDO,L1,IP)        ,C2(INC,IDL1,IP)
   5      2               ,CH2(INC,IDL1,IP)         ,WA(*)
   6       REAL*8 ARG,DCP,DSP,AR1,AI1,AR1H,DC2,DS2,AR2,AI2,AR2H,TPI
   7       DATA TPI /6.283185307179590/
   8 C
   9       ARG = TPI/IP
  10       DCP = COS(ARG)
  11       DSP = SIN(ARG)
  12       IPPH = (IP+1)/2
  13       IPP2 = IP+2
  14 C     IPPHC = IPP2-IPPH
  15 C     IPPH2= 2*IPPH
  16       IDP2 = IDO+2
  17 C
  18       IF (IDO .EQ. 1) GO TO 1000
  19       DO 101 IK=1,IDL1
  20           DO 101 L=1,LOT
  21   101         CH2(L,IK,1) = C2(L,IK,1)
  22       DO 104 J=2,IP
  23       DO 104 K=1,L1
  24           DO 103 L=1,LOT
  25   103         CH(L,1,K,J) = C1(L,1,K,J)
  26   104 CONTINUE
  27           IS = -IDO
  28 *VOPTION NOFVAL
  29       DO 116 J=2,IP
  30             IS = IS+IDO
  31         DO 115 K=1,L1
  32 *VOPTION NOFVAL
  33           DO 114 I=3,IDO,2
  34               IDIJ = IS+I-1
  35             DO 113 L=1,LOT
  36               CH(L,I-1,K,J) =
  37      *                WA(IDIJ-1)*C1(L,I-1,K,J)+WA(IDIJ)*C1(L,I  ,K,J)
  38               CH(L,I  ,K,J) =
  39      *                WA(IDIJ-1)*C1(L,I  ,K,J)-WA(IDIJ)*C1(L,I-1,K,J)
  40   113       CONTINUE
  41   114     CONTINUE
  42   115   CONTINUE
  43   116 CONTINUE
  44 *VOPTION NOFVAL
  45       DO 120 J=2,IPPH
  46             JC = IPP2-J
  47         DO 119 K=1,L1
  48         DO 119 I=3,IDO,2
  49             DO 118 L=1,LOT
  50               C1(L,I-1,K,J ) = CH(L,I-1,K,J )+CH(L,I-1,K,JC)
  51               C1(L,I  ,K,J ) = CH(L,I  ,K,J )+CH(L,I  ,K,JC)
  52               C1(L,I-1,K,JC) = CH(L,I  ,K,J )-CH(L,I  ,K,JC)
  53               C1(L,I  ,K,JC) = CH(L,I-1,K,JC)-CH(L,I-1,K,J )
  54   118       CONTINUE
  55   119   CONTINUE
  56   120 CONTINUE
  57       GO TO 2000
  58 C
  59  1000 CONTINUE
  60       DO 122 IK=1,IDL1
  61         DO 122 L=1,LOT
  62   122    C2(L,IK,1) = CH2(L,IK,1)
  63 C
  64  2000 CONTINUE
  65 *VOPTION NOFVAL
  66       DO 125 J=2,IPPH
  67               JC = IPP2-J
  68         DO 124 K=1,L1
  69             DO 124 L=1,LOT
  70               C1(L,1,K,J ) = CH(L,1,K,J )+CH(L,1,K,JC)
  71               C1(L,1,K,JC) = CH(L,1,K,JC)-CH(L,1,K,J )
  72   124       CONTINUE
  73   125 CONTINUE
  74         AR1 = 1.0
  75         AI1 = 0.0
  76 *VOPTION NOFVAL
  77       DO 134 M=2,IPPH
  78             MC = IPP2-M
  79             AR1H = DCP*AR1-DSP*AI1
  80             AI1  = DCP*AI1+DSP*AR1
  81             AR1  = AR1H
  82         DO 131 IK=1,IDL1
  83           DO 131 L=1,LOT
  84             CH2(L,IK,M ) = C2(L,IK,1)+AR1*C2(L,IK, 2)
  85             CH2(L,IK,MC) =            AI1*C2(L,IK,IP)
  86   131     CONTINUE
  87             DC2 = AR1
  88             DS2 = AI1
  89             AR2 = AR1
  90             AI2 = AI1
  91 *VOPTION NOFVAL
  92         DO 133 J=3,IPPH
  93               JC = IPP2-J
  94               AR2H = DC2*AR2-DS2*AI2
  95               AI2  = DC2*AI2+DS2*AR2
  96               AR2  = AR2H
  97           DO 132 IK=1,IDL1
  98             DO 132 L=1,LOT
  99               CH2(L,IK,M ) = CH2(L,IK,M )+AR2*C2(L,IK,J )
 100               CH2(L,IK,MC) = CH2(L,IK,MC)+AI2*C2(L,IK,JC)
 101   132       CONTINUE
 102   133   CONTINUE
 103   134 CONTINUE
 104       DO 137 J=2,IPPH
 105         DO 137 IK=1,IDL1
 106             DO 136 L=1,LOT
 107   136         CH2(L,IK,1) = CH2(L,IK,1)+C2(L,IK,J)
 108   137     CONTINUE
 109       DO 148 K=1,L1
 110         DO 148 I=1,IDO
 111           DO 147 L=1,LOT
 112   147        CC(L,I,1,K) = CH(L,I,K,1)
 113   148 CONTINUE
 114 *VOPTION NOFVAL
 115       DO 159 J=2,IPPH
 116               JC = IPP2-J
 117               J2 = J+J
 118         DO 158 K=1,L1
 119             DO 158 L=1,LOT
 120               CC(L,IDO,J2-2,K) = CH(L,1,K,J )
 121               CC(L,  1,J2-1,K) = CH(L,1,K,JC)
 122   158       CONTINUE
 123   159 CONTINUE
 124       IF (IDO .EQ. 1) RETURN
 125 *VOPTION NOFVAL
 126       DO 167 J=2,IPPH
 127             JC = IPP2-J
 128             J2 = J+J
 129         DO 166 K=1,L1
 130 *VOPTION NOFVAL
 131           DO 165 I=3,IDO,2
 132               IC = IDP2-I
 133             DO 164 L=1,LOT
 134               CC(L,I -1,J2-1,K) = CH(L,I-1,K,J )+CH(L,I-1,K,JC)
 135               CC(L,I   ,J2-1,K) = CH(L,I  ,K,J )+CH(L,I  ,K,JC)
 136               CC(L,IC-1,J2-2,K) = CH(L,I-1,K,J )-CH(L,I-1,K,JC)
 137               CC(L,IC  ,J2-2,K) = CH(L,I  ,K,JC)-CH(L,I  ,K,J )
 138   164       CONTINUE
 139   165     CONTINUE
 140   166   CONTINUE
 141   167 CONTINUE
 142       RETURN
 143       END SUBROUTINE RADFGM
 144