wrfv2_fire/external/fftpack/fftpack5/xercon.F

   1 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
   2 !
   3 !   FFTPACK 5.0
   4 !   Copyright (C) 1995-2004, Scientific Computing Division,
   5 !   University Corporation for Atmospheric Research
   6 !   Licensed under the GNU General Public License (GPL)
   7 !
   8 !   Authors:  Paul N. Swarztrauber and Richard A. Valent
   9 !
  10 !   $Id: xercon.f,v 1.2 2004/06/15 21:29:20 rodney Exp $
  11 !
  12 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  13
  14       LOGICAL FUNCTION XERCON (INC,JUMP,N,LOT)
  15       INTEGER INC, JUMP, N, LOT
  16       INTEGER I, J, JNEW, LCM
  17 !
  18 !     Definition: positive integers INC, JUMP, N and LOT are consistent
  19 !                                                            ----------
  20 !     if I1*INC + J1*JUMP = I2*INC + J2*JUMP for I1,I2 < N and J1,J2
  21 !     < LOT implies I1=I2 and J1=J2.
  22 !
  23 !     For multiple FFTs to execute correctly, input parameters INC,
  24 !     JUMP, N and LOT must be consistent ... otherwise at least one
  25 !     array element mistakenly is transformed more than once.
  26 !
  27 !     XERCON = .TRUE. if and only if INC, JUMP, N and LOT are
  28 !     consistent.
  29 !
  30 !     ------------------------------------------------------------------
  31 !
  32 !     Compute I = greatest common divisor (INC, JUMP)
  33 !
  34       I = INC
  35       J = JUMP
  36    10 CONTINUE
  37       IF (J .NE. 0) THEN
  38         JNEW = MOD(I,J)
  39         I    = J
  40         J    = JNEW
  41         GO TO 10
  42       ENDIF
  43 !
  44 ! Compute LCM = least common multiple (INC, JUMP)
  45 !
  46       LCM = (INC*JUMP)/I
  47 !
  48 ! Check consistency of INC, JUMP, N, LOT
  49 !
  50       IF (LCM .LE. (N-1)*INC .AND. LCM .LE. (LOT-1)*JUMP) THEN
  51         XERCON = .FALSE.
  52       ELSE
  53         XERCON = .TRUE.
  54       ENDIF
  55 !
  56       RETURN
  57       END