wrfv2_fire/external/fftpack/fftpack5/mrftf1.F

   1 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
   2 !
   3 !   FFTPACK 5.0
   4 !
   5 !   Authors:  Paul N. Swarztrauber and Richard A. Valent
   6 !
   7 !   $Id: mrftf1.f,v 1.2 2004/06/15 21:29:20 rodney Exp $
   8 !
   9 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  10
  11       SUBROUTINE MRFTF1 (M,IM,N,IN,C,CH,WA,FAC)
  12       REAL       CH(M,*) ,C(IN,*)  ,WA(N)   ,FAC(15)
  13 !
  14       NF = FAC(2)
  15       NA = 1
  16       L2 = N
  17       IW = N
  18       DO 111 K1=1,NF
  19          KH = NF-K1
  20          IP = FAC(KH+3)
  21          L1 = L2/IP
  22          IDO = N/L2
  23          IDL1 = IDO*L1
  24          IW = IW-(IP-1)*IDO
  25          NA = 1-NA
  26          IF (IP .NE. 4) GO TO 102
  27          IX2 = IW+IDO
  28          IX3 = IX2+IDO
  29          IF (NA .NE. 0) GO TO 101
  30          CALL MRADF4 (M,IDO,L1,C,IM,IN,CH,1,M,WA(IW),WA(IX2),WA(IX3))
  31          GO TO 110
  32   101    CALL MRADF4 (M,IDO,L1,CH,1,M,C,IM,IN,WA(IW),WA(IX2),WA(IX3))
  33          GO TO 110
  34   102    IF (IP .NE. 2) GO TO 104
  35          IF (NA .NE. 0) GO TO 103
  36          CALL MRADF2 (M,IDO,L1,C,IM,IN,CH,1,M,WA(IW))
  37          GO TO 110
  38   103    CALL MRADF2 (M,IDO,L1,CH,1,M,C,IM,IN,WA(IW))
  39          GO TO 110
  40   104    IF (IP .NE. 3) GO TO 106
  41          IX2 = IW+IDO
  42          IF (NA .NE. 0) GO TO 105
  43          CALL MRADF3 (M,IDO,L1,C,IM,IN,CH,1,M,WA(IW),WA(IX2))
  44          GO TO 110
  45   105    CALL MRADF3 (M,IDO,L1,CH,1,M,C,IM,IN,WA(IW),WA(IX2))
  46          GO TO 110
  47   106    IF (IP .NE. 5) GO TO 108
  48          IX2 = IW+IDO
  49          IX3 = IX2+IDO
  50          IX4 = IX3+IDO
  51          IF (NA .NE. 0) GO TO 107
  52          CALL MRADF5(M,IDO,L1,C,IM,IN,CH,1,M,WA(IW),WA(IX2),            &
  53      &                      WA(IX3),WA(IX4))
  54          GO TO 110
  55   107    CALL MRADF5(M,IDO,L1,CH,1,M,C,IM,IN,WA(IW),WA(IX2),            &
  56      &                      WA(IX3),WA(IX4))
  57          GO TO 110
  58   108    IF (IDO .EQ. 1) NA = 1-NA
  59          IF (NA .NE. 0) GO TO 109
  60          CALL MRADFG (M,IDO,IP,L1,IDL1,C,C,C,IM,IN,CH,CH,1,M,WA(IW))
  61          NA = 1
  62          GO TO 110
  63   109    CALL MRADFG (M,IDO,IP,L1,IDL1,CH,CH,CH,1,M,C,C,IM,IN,WA(IW))
  64          NA = 0
  65   110    L2 = L1
  66   111 END DO
  67       SN = 1./N
  68       TSN = 2./N
  69       TSNM = -TSN
  70       MODN = MOD(N,2)
  71       NL = N-2
  72       IF(MODN .NE. 0) NL = N-1
  73       IF (NA .NE. 0) GO TO 120
  74       M2 = 1-IM
  75       DO 117 I=1,M
  76          M2 = M2+IM
  77          C(M2,1) = SN*CH(I,1)
  78   117 END DO
  79       DO 118 J=2,NL,2
  80       M2 = 1-IM
  81       DO 118 I=1,M
  82          M2 = M2+IM
  83          C(M2,J) = TSN*CH(I,J)
  84          C(M2,J+1) = TSNM*CH(I,J+1)
  85   118 CONTINUE
  86       IF(MODN .NE. 0) RETURN
  87       M2 = 1-IM
  88       DO 119 I=1,M
  89          M2 = M2+IM
  90          C(M2,N) = SN*CH(I,N)
  91   119 END DO
  92       RETURN
  93   120 M2 = 1-IM
  94       DO 121 I=1,M
  95          M2 = M2+IM
  96          C(M2,1) = SN*C(M2,1)
  97   121 END DO
  98       DO 122 J=2,NL,2
  99       M2 = 1-IM
 100       DO 122 I=1,M
 101          M2 = M2+IM
 102          C(M2,J) = TSN*C(M2,J)
 103          C(M2,J+1) = TSNM*C(M2,J+1)
 104   122 CONTINUE
 105       IF(MODN .NE. 0) RETURN
 106       M2 = 1-IM
 107       DO 123 I=1,M
 108          M2 = M2+IM
 109          C(M2,N) = SN*C(M2,N)
 110   123 END DO
 111       RETURN
 112       END