wrfv2_fire/external/fftpack/fftpack5/xerfft.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: xerfft.f,v 1.3 2004/07/06 00:58:41 rodney Exp $
  11 !
  12 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  13
  14       SUBROUTINE XERFFT( SRNAME, INFO)
  15 !
  16 !     .. Scalar Arguments ..
  17       CHARACTER*6        SRNAME
  18       INTEGER            INFO
  19 !
  20 !     ..
  21 !
  22 !  Purpose
  23 !  =======
  24 !
  25 !  XERFFT  is an error handler for library FFTPACK version 5.0 routines.
  26 !  It is called by an FFTPACK 5.0 routine if an input parameter has an
  27 !  invalid value.  A message is printed and execution stops.
  28 !
  29 !  Installers may consider modifying the STOP statement in order to
  30 !  call system-specific exception-handling facilities.
  31 !
  32 !  Arguments
  33 !  =========
  34 !
  35 !  SRNAME  (input) CHARACTER*6
  36 !          The name of the routine which called XERFFT.
  37 !
  38 !  INFO    (input) INTEGER
  39 !          When a single  invalid parameter in the parameter list of
  40 !          the calling routine has been detected, INFO is the position
  41 !          of that parameter.  In the case when an illegal combination
  42 !          of LOT, JUMP, N, and INC has been detected, the calling
  43 !          subprogram calls XERFFT with INFO = -1.
  44 !
  45 ! =====================================================================
  46 !
  47 !     .. Executable Statements ..
  48 !
  49       IF (INFO .GE. 1) THEN
  50         WRITE( *, '(A,A,A,I3,A)') ' ** On entry to ', SRNAME,           &
  51      &    ' parameter number ', INFO, ' had an illegal value'
  52       ELSEIF (INFO .EQ. -1) THEN
  53         WRITE( *, '(A,A,A,A)') ' ** On entry to ', SRNAME,              &
  54      &    ' parameters LOT, JUMP, N and INC are inconsistent'
  55       ELSEIF (INFO .EQ. -2) THEN
  56         WRITE( *, '(A,A,A,A)') ' ** On entry to ', SRNAME,              &
  57      &    ' parameter L is greater than LDIM'
  58       ELSEIF (INFO .EQ. -3) THEN
  59         WRITE( *, '(A,A,A,A)') ' ** On entry to ', SRNAME,              &
  60      &    ' parameter M is greater than MDIM'
  61       ELSEIF (INFO .EQ. -5) THEN
  62         WRITE( *, '(A,A,A,A)') ' ** Within ', SRNAME,                   &
  63      &    ' input error returned by lower level routine'
  64       ELSEIF (INFO .EQ. -6) THEN
  65         WRITE( *, '(A,A,A,A)') ' ** On entry to ', SRNAME,              &
  66      &    ' parameter LDIM is less than 2*(L/2+1)'
  67       ENDIF
  68 !
  69       STOP
  70 !
  71 !     End of XERFFT
  72 !
  73       END