var/convertor/kma_wave2grid/RADB5M.inc

   1 C***********************************************************************
   2       SUBROUTINE RADB5M (INC,LOT,IDO,L1,CC,CH,WA1,WA2,WA3,WA4)
   3       DIMENSION       CC(INC,IDO,5,L1)       ,CH(INC,IDO,L1,5)
   4      1               ,WA1(*)     ,WA2(*)     ,WA3(*)     ,WA4(*)
   5       DATA TR11,TI11,TR12,TI12 /.3090169943749470,.9510565162951540,
   6      1                         -.8090169943749470,.5877852522924730/
   7       DO 101 K=1,L1
   8 *VOPTION NOFVAL
   9         DO 101 L=1,LOT
  10           TR2         = CC(L,IDO,2,K)+CC(L,IDO,2,K)
  11           TR3         = CC(L,IDO,4,K)+CC(L,IDO,4,K)
  12           TI5         = CC(L,  1,3,K)+CC(L,  1,3,K)
  13           TI4         = CC(L,  1,5,K)+CC(L,  1,5,K)
  14           CR2         = CC(L,  1,1,K)+TR11*TR2+TR12*TR3
  15           CI5         =               TI11*TI5+TI12*TI4
  16           CR3         = CC(L,  1,1,K)+TR12*TR2+TR11*TR3
  17           CI4         =               TI12*TI5-TI11*TI4
  18           CH(L,1,K,1) = CC(L,  1,1,K)+TR2+TR3
  19           CH(L,1,K,2) = CR2-CI5
  20           CH(L,1,K,3) = CR3-CI4
  21           CH(L,1,K,4) = CR3+CI4
  22           CH(L,1,K,5) = CR2+CI5
  23   101   CONTINUE
  24       IF (IDO .GT. 1) THEN
  25           IDP2 = IDO+2
  26         DO 103 K=1,L1
  27 *VOPTION NOFVAL
  28         DO 103 I=3,IDO,2
  29             IC = IDP2-I
  30 *VOPTION NOFVAL
  31           DO 102 L=1,LOT
  32             TR2           = CC(L,I-1,3,K)+CC(L,IC-1,2,K)
  33             TI2           = CC(L,I  ,3,K)-CC(L,IC  ,2,K)
  34             TR3           = CC(L,I-1,5,K)+CC(L,IC-1,4,K)
  35             TI3           = CC(L,I  ,5,K)-CC(L,IC  ,4,K)
  36             TR4           = CC(L,I-1,5,K)-CC(L,IC-1,4,K)
  37             TI4           = CC(L,I  ,5,K)+CC(L,IC  ,4,K)
  38             TR5           = CC(L,I-1,3,K)-CC(L,IC-1,2,K)
  39             TI5           = CC(L,I  ,3,K)+CC(L,IC  ,2,K)
  40             CR2           = CC(L,I-1,1,K)+TR11*TR2+TR12*TR3
  41             CI2           = CC(L,I  ,1,K)+TR11*TI2+TR12*TI3
  42             CR4           =               TI12*TR5-TI11*TR4
  43             CI4           =               TI12*TI5-TI11*TI4
  44             CR3           = CC(L,I-1,1,K)+TR12*TR2+TR11*TR3
  45             CI3           = CC(L,I  ,1,K)+TR12*TI2+TR11*TI3
  46             CR5           =               TI11*TR5+TI12*TR4
  47             CI5           =               TI11*TI5+TI12*TI4
  48             CH(L,I-1,K,1) = CC(L,I-1,1,K)+     TR2+     TR3
  49             CH(L,I  ,K,1) = CC(L,I  ,1,K)+     TI2+     TI3
  50             DR2           = CR2-CI5
  51             DI2           = CI2+CR5
  52             DR3           = CR3-CI4
  53             DI3           = CI3+CR4
  54             DR4           = CR3+CI4
  55             DI4           = CI3-CR4
  56             DR5           = CR2+CI5
  57             DI5           = CI2-CR5
  58             CH(L,I-1,K,2) = WA1(I-2)*DR2-WA1(I-1)*DI2
  59             CH(L,I  ,K,2) = WA1(I-2)*DI2+WA1(I-1)*DR2
  60             CH(L,I-1,K,3) = WA2(I-2)*DR3-WA2(I-1)*DI3
  61             CH(L,I  ,K,3) = WA2(I-2)*DI3+WA2(I-1)*DR3
  62             CH(L,I-1,K,4) = WA3(I-2)*DR4-WA3(I-1)*DI4
  63             CH(L,I  ,K,4) = WA3(I-2)*DI4+WA3(I-1)*DR4
  64             CH(L,I-1,K,5) = WA4(I-2)*DR5-WA4(I-1)*DI5
  65             CH(L,I  ,K,5) = WA4(I-2)*DI5+WA4(I-1)*DR5
  66   102     CONTINUE
  67   103   CONTINUE
  68       END IF
  69       RETURN
  70       END SUBROUTINE RADB5M
  71