var/convertor/kma_wave2grid/RADBGM.inc

   1 C***********************************************************************
   2       SUBROUTINE RADBGM (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       IDP2 = IDO+2
  13       IPP2 = IP+2
  14       IPPH = (IP+1)/2
  15 C     IPPHC = IPP2-IPPH
  16 C     IPPH2 = 2*IPPH
  17 C
  18       DO 102 K=1,L1
  19       DO 102 I=1,IDO
  20             DO 101 L=1,LOT
  21   101         CH(L,I,K,1) = CC(L,I,1,K)
  22   102 CONTINUE
  23 *VOPTION NOFVAL
  24       DO 113 J=2,IPPH
  25               JC = IPP2-J
  26               J2 = J+J
  27       DO 113 K=1,L1
  28             DO 112 L=1,LOT
  29               CH(L,1,K,J ) = CC(L,IDO,J2-2,K)+CC(L,IDO,J2-2,K)
  30               CH(L,1,K,JC) = CC(L,  1,J2-1,K)+CC(L,  1,J2-1,K)
  31   112       CONTINUE
  32   113 CONTINUE
  33       IF (IDO .NE. 1) THEN
  34 *VOPTION NOFVAL
  35         DO 121 J=2,IPPH
  36             JC = IPP2-J
  37           DO 120 K=1,L1
  38 *VOPTION NOFVAL
  39             DO 119 I=3,IDO,2
  40                 IC = IDP2-I
  41               DO 118 L=1,LOT
  42                 CH(L,I-1,K,J ) = CC(L,I-1,2*J-1,K)+CC(L,IC-1,2*J-2,K)
  43                 CH(L,I  ,K,J ) = CC(L,I  ,2*J-1,K)-CC(L,IC  ,2*J-2,K)
  44                 CH(L,I-1,K,JC) = CC(L,I-1,2*J-1,K)-CC(L,IC-1,2*J-2,K)
  45                 CH(L,I  ,K,JC) = CC(L,I  ,2*J-1,K)+CC(L,IC  ,2*J-2,K)
  46   118         CONTINUE
  47   119       CONTINUE
  48   120     CONTINUE
  49   121   CONTINUE
  50       ENDIF
  51             AR1 = 1.0
  52             AI1 = 0.0
  53 *VOPTION NOFVAL
  54       DO 126 M=2,IPPH
  55             MC = IPP2-M
  56             AR1H = DCP*AR1-DSP*AI1
  57             AI1  = DCP*AI1+DSP*AR1
  58             AR1  = AR1H
  59         DO 123 IK=1,IDL1
  60           DO 123 L=1,LOT
  61             C2(L,IK,M ) = CH2(L,IK,1)+AR1*CH2(L,IK, 2)
  62             C2(L,IK,MC) =             AI1*CH2(L,IK,IP)
  63   123     CONTINUE
  64             DC2 = AR1
  65             DS2 = AI1
  66             AR2 = AR1
  67             AI2 = AI1
  68 *VOPTION NOFVAL
  69         DO 125 J=3,IPPH
  70               JC = IPP2-J
  71               AR2H = DC2*AR2-DS2*AI2
  72               AI2  = DC2*AI2+DS2*AR2
  73               AR2  = AR2H
  74           DO 124 IK=1,IDL1
  75             DO 124 L=1,LOT
  76               C2(L,IK,M ) = C2(L,IK,M )+AR2*CH2(L,IK,J )
  77               C2(L,IK,MC) = C2(L,IK,MC)+AI2*CH2(L,IK,JC)
  78   124       CONTINUE
  79   125   CONTINUE
  80   126 CONTINUE
  81       DO 129 J=2,IPPH
  82       DO 129 IK=1,IDL1
  83           DO 128 L=1,LOT
  84   128       CH2(L,IK,1) = CH2(L,IK,1)+CH2(L,IK,J)
  85   129 CONTINUE
  86 *VOPTION NOFVAL
  87       DO 141 J=2,IPPH
  88               JC = IPP2-J
  89       DO 141 K=1,L1
  90             DO 140 L=1,LOT
  91               CH(L,1,K,J ) = C1(L,1,K,J)-C1(L,1,K,JC)
  92               CH(L,1,K,JC) = C1(L,1,K,J)+C1(L,1,K,JC)
  93   140       CONTINUE
  94   141 CONTINUE
  95       IF (IDO .EQ. 1) RETURN
  96 *VOPTION NOFVAL
  97       DO 150 J=2,IPPH
  98             JC = IPP2-J
  99         DO 149 K=1,L1
 100         DO 149 I=3,IDO,2
 101             DO 148 L=1,LOT
 102               CH(L,I-1,K,J ) = C1(L,I-1,K,J)-C1(L,I  ,K,JC)
 103               CH(L,I  ,K,J ) = C1(L,I  ,K,J)+C1(L,I-1,K,JC)
 104               CH(L,I-1,K,JC) = C1(L,I-1,K,J)+C1(L,I  ,K,JC)
 105               CH(L,I  ,K,JC) = C1(L,I  ,K,J)-C1(L,I-1,K,JC)
 106   148       CONTINUE
 107   149   CONTINUE
 108   150 CONTINUE
 109       DO 152 IK=1,IDL1
 110         DO 152 L=1,LOT
 111   152      C2(L,IK,1) = CH2(L,IK,1)
 112       DO 155 J=2,IP
 113         DO 155 K=1,L1
 114           DO 154 L=1,LOT
 115   154         C1(L,1,K,J) = CH(L,1,K,J)
 116   155     CONTINUE
 117           IS = -IDO
 118 *VOPTION NOFVAL
 119       DO 169 J=2,IP
 120             IS = IS+IDO
 121         DO 168 K=1,L1
 122 *VOPTION NOFVAL
 123           DO 167 I=3,IDO,2
 124               IDIJ = IS+I-1
 125             DO 166 L=1,LOT
 126               C1(L,I-1,K,J) =
 127      *               WA(IDIJ-1)*CH(L,I-1,K,J)-WA(IDIJ)*CH(L,I  ,K,J)
 128               C1(L,I  ,K,J) =
 129      *               WA(IDIJ-1)*CH(L,I  ,K,J)+WA(IDIJ)*CH(L,I-1,K,J)
 130   166       CONTINUE
 131   167     CONTINUE
 132   168   CONTINUE
 133   169 CONTINUE
 134       RETURN
 135       END SUBROUTINE RADBGM
 136