var/convertor/kma_wave2grid/RADF5M.inc

   1 C***********************************************************************
   2       SUBROUTINE RADF5M (INC,LOT,IDO,L1,CC,CH,WA1,WA2,WA3,WA4)
   3       DIMENSION       CC(INC,IDO,L1,5)       ,CH(INC,IDO,5,L1)
   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           CR2           = CC(L,1,K,5)+CC(L,1,K,2)
  11           CR3           = CC(L,1,K,4)+CC(L,1,K,3)
  12           CI5           = CC(L,1,K,5)-CC(L,1,K,2)
  13           CI4           = CC(L,1,K,4)-CC(L,1,K,3)
  14           CH(L,  1,1,K) = CC(L,1,K,1)+     CR2+     CR3
  15           CH(L,  1,3,K) =             TI11*CI5+TI12*CI4
  16           CH(L,IDO,2,K) = CC(L,1,K,1)+TR11*CR2+TR12*CR3
  17           CH(L,  1,5,K) =             TI12*CI5-TI11*CI4
  18           CH(L,IDO,4,K) = CC(L,1,K,1)+TR12*CR2+TR11*CR3
  19   101   CONTINUE
  20       IF (IDO .GT. 1) THEN
  21           IDP2 = IDO+2
  22         DO 103 K=1,L1
  23 *VOPTION NOFVAL
  24         DO 103 I=3,IDO,2
  25             IC = IDP2-I
  26 *VOPTION NOFVAL
  27           DO 102 L=1,LOT
  28             CA2            = WA1(I-2)*CC(L,I-1,K,2)
  29             CU2            = WA1(I-2)*CC(L,I  ,K,2)
  30             CA3            = WA2(I-2)*CC(L,I-1,K,3)
  31             CU3            = WA2(I-2)*CC(L,I  ,K,3)
  32             CA4            = WA3(I-2)*CC(L,I-1,K,4)
  33             CU4            = WA3(I-2)*CC(L,I  ,K,4)
  34             CA5            = WA4(I-2)*CC(L,I-1,K,5)
  35             CU5            = WA4(I-2)*CC(L,I  ,K,5)
  36             CB2            = WA1(I-1)*CC(L,I-1,K,2)
  37             CV2            = WA1(I-1)*CC(L,I  ,K,2)
  38             CB3            = WA2(I-1)*CC(L,I-1,K,3)
  39             CV3            = WA2(I-1)*CC(L,I  ,K,3)
  40             CB4            = WA3(I-1)*CC(L,I-1,K,4)
  41             CV4            = WA3(I-1)*CC(L,I  ,K,4)
  42             CB5            = WA4(I-1)*CC(L,I-1,K,5)
  43             CV5            = WA4(I-1)*CC(L,I  ,K,5)
  44             CH(L,IC-1,2,K) = CA2+CV2
  45             CH(L,IC  ,2,K) = CU2-CB2
  46             CH(L,I -1,3,K) = CA3+CV3
  47             CH(L,I   ,3,K) = CU3-CB3
  48             CH(L,IC-1,4,K) = CA4+CV4
  49             CH(L,IC  ,4,K) = CU4-CB4
  50             CH(L,I -1,5,K) = CA5+CV5
  51             CH(L,I   ,5,K) = CU5-CB5
  52   102     CONTINUE
  53   103   CONTINUE
  54         DO 105 K=1,L1
  55 *VOPTION NOFVAL
  56         DO 105 I=3,IDO,2
  57              IC = IDP2-I
  58           DO 104 L=1,LOT
  59             CC(L,I-1,K,2) = CH(L,IC-1,2,K)+CH(L,I -1,5,K)
  60             CC(L,I  ,K,2) = CH(L,IC  ,2,K)+CH(L,I   ,5,K)
  61             CC(L,I-1,K,3) = CH(L,I -1,3,K)+CH(L,IC-1,4,K)
  62             CC(L,I  ,K,3) = CH(L,I   ,3,K)+CH(L,IC  ,4,K)
  63             CC(L,I-1,K,4) = CH(L,I   ,3,K)-CH(L,IC  ,4,K)
  64             CC(L,I  ,K,4) = CH(L,IC-1,4,K)-CH(L,I -1,3,K)
  65             CC(L,I-1,K,5) = CH(L,IC  ,2,K)-CH(L,I   ,5,K)
  66             CC(L,I  ,K,5) = CH(L,I -1,5,K)-CH(L,IC-1,2,K)
  67   104     CONTINUE
  68   105   CONTINUE
  69         DO 107 K=1,L1
  70         DO 107 I=3,IDO,2
  71              IC = IDP2-I
  72 *VOPTION NOFVAL
  73           DO 106 L=1,LOT
  74             CTR2           = TR11*CC(L,I-1,K,2)+TR12*CC(L,I-1,K,3)
  75             CTI2           = TR11*CC(L,I  ,K,2)+TR12*CC(L,I  ,K,3)
  76             CTR3           = TR12*CC(L,I-1,K,2)+TR11*CC(L,I-1,K,3)
  77             CTI3           = TR12*CC(L,I  ,K,2)+TR11*CC(L,I  ,K,3)
  78             TR2            = CTR2+CC(L,I-1,K,1)
  79             TI2            = CTI2+CC(L,I  ,K,1)
  80             TR3            = CTR3+CC(L,I-1,K,1)
  81             TI3            = CTI3+CC(L,I  ,K,1)
  82             TR4            = TI12*CC(L,I-1,K,5)-TI11*CC(L,I-1,K,4)
  83             TI4            = TI12*CC(L,I  ,K,5)-TI11*CC(L,I  ,K,4)
  84             SR23           = CC(L,I-1,K,2)+CC(L,I-1,K,3)
  85             SI23           = CC(L,I  ,K,2)+CC(L,I  ,K,3)
  86             TR5            = TI11*CC(L,I-1,K,5)+TI12*CC(L,I-1,K,4)
  87             TI5            = TI11*CC(L,I  ,K,5)+TI12*CC(L,I  ,K,4)
  88             CH(L,I -1,1,K) = CC(L,I-1,K,1)+SR23
  89             CH(L,I   ,1,K) = CC(L,I  ,K,1)+SI23
  90             CH(L,IC-1,2,K) = TR2-TR5
  91             CH(L,IC  ,2,K) = TI5-TI2
  92             CH(L,I -1,3,K) = TR2+TR5
  93             CH(L,I   ,3,K) = TI2+TI5
  94             CH(L,IC-1,4,K) = TR3-TR4
  95             CH(L,IC  ,4,K) = TI4-TI3
  96             CH(L,I -1,5,K) = TR3+TR4
  97             CH(L,I   ,5,K) = TI3+TI4
  98   106     CONTINUE
  99   107   CONTINUE
 100       END IF
 101       RETURN
 102       END SUBROUTINE RADF5M
 103