var/convertor/kma_wave2grid/RADF4M.inc

   1 C***********************************************************************
   2       SUBROUTINE RADF4M (INC,LOT,IDO,L1,CC,CH,WA1,WA2,WA3)
   3       DIMENSION       CC(INC,IDO,L1,4)       ,CH(INC,IDO,4,L1)
   4      1               ,WA1(*)     ,WA2(*)     ,WA3(*)
   5       DATA HSQT2 /.70710678118654750/
   6       DO 101 K=1,L1
   7 *VOPTION NOFVAL
   8         DO 101 L=1,LOT
   9           TR1           = CC(L,1,K,2)+CC(L,1,K,4)
  10           TR2           = CC(L,1,K,1)+CC(L,1,K,3)
  11           CH(L,  1,3,K) = CC(L,1,K,4)-CC(L,1,K,2)
  12           CH(L,  1,1,K) = TR1+TR2
  13           CH(L,IDO,2,K) = CC(L,1,K,1)-CC(L,1,K,3)
  14           CH(L,IDO,4,K) = TR2-TR1
  15   101   CONTINUE
  16       IF (MOD(IDO,2) .EQ. 0) THEN
  17         DO 102 K=1,L1
  18 *VOPTION NOFVAL
  19           DO 102 L=1,LOT
  20             TR1           =  HSQT2*(CC(L,IDO,K,2)-CC(L,IDO,K,4))
  21             TI1           = -HSQT2*(CC(L,IDO,K,2)+CC(L,IDO,K,4))
  22             CH(L,IDO,1,K) = CC(L,IDO,K,1)+TR1
  23             CH(L,  1,2,K) = TI1          -CC(L,IDO,K,3)
  24             CH(L,IDO,3,K) = CC(L,IDO,K,1)-TR1
  25             CH(L,  1,4,K) = TI1          +CC(L,IDO,K,3)
  26   102     CONTINUE
  27       END IF
  28       IF (IDO .GT. 2) THEN
  29           IDP2 = IDO+2
  30         DO 104 K=1,L1
  31 *VOPTION NOFVAL
  32         DO 104 I=3,IDO,2
  33              IC = IDP2-I
  34 *VOPTION NOFVAL
  35           DO 103 L=1,LOT
  36             CR2 = WA1(I-2)*CC(L,I-1,K,2)+WA1(I-1)*CC(L,I  ,K,2)
  37             CI2 = WA1(I-2)*CC(L,I  ,K,2)-WA1(I-1)*CC(L,I-1,K,2)
  38             CR3 = WA2(I-2)*CC(L,I-1,K,3)+WA2(I-1)*CC(L,I  ,K,3)
  39             CI3 = WA2(I-2)*CC(L,I  ,K,3)-WA2(I-1)*CC(L,I-1,K,3)
  40             CR4 = WA3(I-2)*CC(L,I-1,K,4)+WA3(I-1)*CC(L,I  ,K,4)
  41             CI4 = WA3(I-2)*CC(L,I  ,K,4)-WA3(I-1)*CC(L,I-1,K,4)
  42             TR2            = CC(L,I-1,K,1)+CR3
  43             TI2            = CC(L,I  ,K,1)+CI3
  44             TR1            = CR2+CR4
  45             TI1            = CI2+CI4
  46             TR3            = CC(L,I-1,K,1)-CR3
  47             TI3            = CC(L,I  ,K,1)-CI3
  48             TR4            = CR4-CR2
  49             TI4            = CI2-CI4
  50             CH(L,I -1,1,K) = TR1+TR2
  51             CH(L,I   ,1,K) = TI1+TI2
  52             CH(L,IC-1,2,K) = TR3-TI4
  53             CH(L,IC  ,2,K) = TR4-TI3
  54             CH(L,I -1,3,K) = TI4+TR3
  55             CH(L,I   ,3,K) = TR4+TI3
  56             CH(L,IC-1,4,K) = TR2-TR1
  57             CH(L,IC  ,4,K) = TI1-TI2
  58   103     CONTINUE
  59   104   CONTINUE
  60       END IF
  61       RETURN
  62       END SUBROUTINE RADF4M
  63