C Copyright 1981-2012 ECMWF.
C
C This software is licensed under the terms of the Apache Licence 
C Version 2.0 which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
C
C In applying this licence, ECMWF does not waive the privileges and immunities 
C granted to it by virtue of its status as an intergovernmental organisation 
C nor does it submit to any jurisdiction.
C

      LOGICAL FUNCTION PPALLOW(NM,SLAT)
C
C---->
C**** PPALLOW
C
C     Purpose
C     -------
C
C     
C     ---------
C
C     LFOUND = PPALLOW(NM,SLAT) 
C
C
C     Input
C     -----
C
C     NM      - Triangular truncation number of the field..
C     SLAT    - Rotation angle (degrees, REAL*8)
C              (degrees, negative => rotate counter-clockwise about the
C                                    new Z-axis).
C
C
C     Output
C     ------
C
C     Function returns .TRUE. if coefficients are in the list of
C     'standard' rotations and allowed in mrfs.
C
C
C     Method
C     ------
C
C     Checks a configuration file to find the allowed rotations.
C     This file may have its pathname given by the environment variable
C     PP_ALLOWED_ROTATIONS or may be in a standard directory.
C     Only picks up configuration values on first call.
C
C     The configuration file is read by Fortran and has format
C     (I4,1X,F8). Eg.
C
C      159 -14.0000
C      319  60.0000
C      319 -60.0000
C
C     Externals
C     ---------
C
C     GETENV - Gets value in an environment variable.
C     INTLOG - Output log message.
C     JDEBUG - Checks environment to switch on/off debug.
C
C
C     Author
C     ------
C
C     J.D.Chambers     ECMWF       June 2000
C
C
C----<
C     -----------------------------------------------------------------|
C
      IMPLICIT NONE
C
#include "jparams.h"
#include "parim.h"
C
C     Function arguments.
C
      INTEGER NM
      REAL*8 SLAT
C
C     Parameters.
C
      INTEGER JPLIST, JPDEFL
      PARAMETER (JPLIST = 20 )
C                       = number of values which can be read
C
      PARAMETER (JPDEFL = 3 )
C                       = number of values in default list
C
C     Local variables.
C
      INTEGER FILENM, LOOP, LISTLEN
      INTEGER NMDEF(JPDEFL), INM(JPLIST)
      REAL*8 SLATDEF(JPDEFL), XLAT(JPLIST)
      CHARACTER*256 FILENAME
      CHARACTER*256 STANDARD
      CHARACTER*16 HOST
      LOGICAL LDEBUG, LFOUND
C
C     Externals
C
      DATA NMDEF/159,319,319/, SLATDEF/-14.0,60.0,-60.0/
      DATA LDEBUG/.FALSE./, LFOUND/.FALSE./
      DATA FILENM/65/
C
      SAVE LDEBUG, LFOUND, INM, XLAT, LISTLEN
C
C     -----------------------------------------------------------------|
C*    Section 1.   Initialise
C     -----------------------------------------------------------------|
C
  100 CONTINUE
C
      PPALLOW = .FALSE.
C
C     Only pick up configuration values on first call
C
      IF( LFOUND ) GOTO 400
C
      LFOUND = .TRUE.
C
      CALL JDEBUG()
      LDEBUG = NDBG.GT.0
C
C     -----------------------------------------------------------------|
C*    Section 2.   Open the configuration file
C     -----------------------------------------------------------------|
C
  200 CONTINUE
C
C     If the environment variable points to a file, try to open it.
C     Otherwise, get the file from a standard directory.
C
      CALL GETENV('PP_ALLOWED_ROTATIONS', FILENAME)
      IF( FILENAME(1:1).NE.' ' ) THEN
        IF( LDEBUG) CALL INTLOG(JP_DEBUG,
     X    'PPALLOW: Trying to open file '//FILENAME,JPQUIET)
        OPEN( FILENM, FILE=FILENAME, STATUS='OLD', ERR=300)
C
      ELSE
C
        CALL GETENV('HOST',HOST)
        IF( HOST(1:7).EQ.'vpp5000') THEN
          STANDARD = '/vpp5000/mrfs/postproc/pp_allowed_rotations'
        ELSE IF (HOST(1:7).EQ.'vpp700e') THEN
          STANDARD = '/vpp700e/mrfs/postproc/pp_allowed_rotations'
        ELSE IF (HOST(1:6).EQ.'vpp700') THEN
          STANDARD = '/vpp700/mrfs/postproc/pp_allowed_rotations'
        ELSE
          STANDARD = '/home/ma/emos/data/pp_allowed_rotations'
        ENDIF
        IF( LDEBUG) CALL INTLOG(JP_DEBUG,
     X    'PPALLOW: Trying to open file '//STANDARD,JPQUIET)
        OPEN( FILENM, FILE=STANDARD, STATUS='OLD', ERR=300)
      ENDIF
C
      IF( LDEBUG) CALL INTLOG(JP_DEBUG, 'PPALLOW: Open OK.',JPQUIET)
      LISTLEN = 0
C
  210 CONTINUE
C
      LISTLEN = LISTLEN + 1
      READ(FILENM,'(I4,1X,F8.4)',END=220) INM(LISTLEN), XLAT(LISTLEN)
      GOTO 210
C
  220 CONTINUE
      CLOSE(FILENM)
      LISTLEN = LISTLEN - 1
C
      GOTO 400
C
C     -----------------------------------------------------------------|
C*    Section 3.   Use the internally defined values.
C     -----------------------------------------------------------------|
C
  300 CONTINUE
C
      IF( LDEBUG) THEN
        CALL INTLOG(JP_DEBUG,
     X    'PPALLOW: No configuration file available.',JPQUIET)
        CALL INTLOG(JP_DEBUG,
     X  'PPALLOW: Using internally defined values.',JPQUIET)
      ENDIF
C
      DO LOOP = 1, JPDEFL
        INM(LOOP)  = NMDEF(LOOP)
        XLAT(LOOP) = SLATDEF(LOOP)
      ENDDO
      LISTLEN = JPDEFL
C
C     -----------------------------------------------------------------|
C*    Section 4.   Check the current values against the list.
C     -----------------------------------------------------------------|
C
  400 CONTINUE
C
      DO LOOP = 1, LISTLEN
        IF( (NM.EQ.INM(LOOP)).AND.(SLAT.EQ.XLAT(LOOP)) ) THEN
          IF( LDEBUG) THEN
            CALL INTLOG(JP_DEBUG,
     X      'PPALLOW: Rotation allowed in mrfs.',JPQUIET)
            CALL INTLOG(JP_DEBUG, 'PPALLOW: Truncation = ',NM)
            CALL INTLOGR(JP_DEBUG,'PPALLOW: Rotation = ', SLAT)
          ENDIF
          PPALLOW = .TRUE.
          GOTO 900
        ENDIF
      ENDDO
C
      IF( LDEBUG ) THEN
        CALL INTLOG(JP_DEBUG,
     X    'PPALLOW: Rotation NOT allowed in mrfs.',JPQUIET)
        CALL INTLOG(JP_DEBUG, 'PPALLOW: Truncation = ',NM)
        CALL INTLOGR(JP_DEBUG,'PPALLOW: Rotation = ', SLAT)
      ENDIF
C
C     -----------------------------------------------------------------|
C*    Section 9.   Return.
C     -----------------------------------------------------------------|
C
  900 CONTINUE
C
      RETURN
      END

