var/convertor/kma_wave2grid/FFT991.inc

   1 c990408
   2       SUBROUTINE FFT991(A,TRIGS,IFAX,INC,JUMP,N,LOT,ISIGN)
   3 C      SUBROUTINE FFT991(A,WORKX,TRIGS,IFAX,INC,JUMP,N,LOT,ISIGN)
   4 C      SUBROUTINE FFT991(A,WORK,TRIGS,IFAX,INC,JUMP,N,LOT,ISIGN)
   5 C=======================================================================
   6 C&&& INC=1 IS ASSUMED ***
   7 C&&& INPUT/OUTPUT HAS A DIMENSION OF N*LOT
   8 C&&& A & WORK SHOULD HAVE A DIMENSION OF JUMP*LOT
   9 C&&& CREATED ON JUN/21/88 BY N.SATO
  10 C=======================================================================
  11       PARAMETER(NFFT=256)
  12
  13 c990408
  14 c      DIMENSION WORKX(N, 1920)
  15
  16       DIMENSION A(N,LOT),WORK(JUMP,NFFT),TRIGS(N),IFAX(*)
  17       DIMENSION WORK2(N*JUMP*NFFT)
  18
  19       IF(ISIGN .EQ. 1) GO TO 2000
  20       DO L0=1,LOT,NFFT
  21       LOTL=MIN(NFFT,LOT-L0+1)
  22
  23       DO 100 L=1,LOTL
  24       DO 100 I=1,N
  25       WORK(I,L)=A(I,L+L0-1)
  26   100 CONTINUE
  27 C
  28 C GRID TO WAVE
  29 C
  30 C   X(0),...,X(N-1) ===> A(0),A(1),B(1),...,A(N/2-1),B(N/2-1),A(N/2)
  31 C
  32           CALL RFFTFM (N,INC,JUMP,LOTL, WORK, TRIGS,IFAX, WORK2 )
  33 C
  34 C   A(0),A(1),B(1),... ===> A(0),B(0),A(1),B(1),...
  35 C
  36 *VOPTION NOFVAL
  37       DO 200 L=1,LOTL
  38       DO 200 I=3,N
  39       A(I,L+L0-1)=WORK(I-1,L)
  40   200 CONTINUE
  41       DO 240 L=1,LOTL
  42       A(1,L+L0-1)=WORK(1,L)
  43       A(2,L+L0-1)=0.0
  44   240 CONTINUE
  45       ENDDO
  46         RETURN
  47 C
  48 C  WAVE TO GRID
  49 C
  50 C    A(0),B(0),A(1),B(1),... ===> A(0),A(1),B(1),...
  51 C
  52  2000 CONTINUE
  53       DO L0=1,LOT,NFFT
  54       LOTL=MIN(NFFT,LOT-L0+1)
  55
  56       DO 300 L=1,LOTL
  57       DO 300 I=3,N
  58       WORK(I-1,L)=A(I,L+L0-1)
  59   300 CONTINUE
  60       DO 340 L=1,LOTL
  61 cnec  DO 340 L=1,LOT
  62       WORK(1,L)=A(1,L+L0-1)
  63       WORK(N,L)=0.0
  64   340 CONTINUE
  65 C
  66 C    A(0),A(1),B(1)...A(N/2-1),B(N/2-1),A(N/2) ===> X(0)...X(N-1)
  67 C
  68           CALL RFFTBM (N,INC,JUMP,LOTL, WORK, TRIGS,IFAX, WORK2)
  69
  70       DO 400 L=1,LOTL
  71       DO 400 I=1,N
  72       A(I,L+L0-1)=WORK(I,L)
  73   400 CONTINUE
  74       ENDDO
  75 C
  76       RETURN
  77       END SUBROUTINE FFT991
  78