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

      INTEGER FUNCTION MAKERL(SHCIN,KTRUNC,SHCOUT,RANGLES)
C
C---->
C**** MAKERL
C
C     Purpose
C     -------
C
C     Rotates a spherical harmonic field.
C
C
C     Interface
C     ---------
C
C     IRET = MAKERL(SHCIN,KTRUNC,SHCOUT,RANGLES)
C
C     Input
C     -----
C
C     SHCIN   - Input array of spherical harmonics.
C     KTRUNC  - Truncation of the spherical harmonics.
C     RANGLES - Coordinates of the south pole of rotation:
C               latitude/longitude.
C
C
C     Output
C     ------
C
C     SHCOUT  - Output array of rotated spherical harmonics.
C
C     Function returns 0 if all OK, otherwise the rotations failed.
C
C
C     Method
C     ------
C
C     None.
C
C
C     Externals
C     ---------
C
C     RPHI    - Rotates spectral coefficients by longitude.
C     JACOBI  - Rotates spectral coefficients by latitude.
C     INTLOG  - Logs messages.
C
C     Author
C     ------
C
C     J.D.Chambers         ECMWF     October, 1995.
C
C
C----<
C---------------------------------------------------------------------
C
C
      IMPLICIT NONE
#include "parim.h"
#include "nofld.common"
C
C     Parameters
C
      INTEGER JPROUTINE
      PARAMETER (JPROUTINE = 28300)
      INTEGER JPLEN, JPNM
      PARAMETER ( JPNM = JPSTRUNC )
      PARAMETER ( JPLEN = (JPNM+1)*(JPNM+2) )
C
C     Function arguments.
C
      REAL SHCIN, SHCOUT, RANGLES
      DIMENSION SHCIN(*), SHCOUT(*), RANGLES(*)
      INTEGER KTRUNC
C
C     Local variables
C
      REAL*8 DLON, DLAT
      REAL*8 WORK
      DIMENSION WORK(2*(JPNM+1)*(JPNM+6))
      LOGICAL LOK
      INTEGER NBYTES, LOOP
#if (defined REAL_8)
      DATA NBYTES/8/
#else
      DATA NBYTES/4/
      REAL*8 DATA
      DIMENSION DATA(JPLEN)
#endif
C
C     Externals
C
      LOGICAL JACOBI
      EXTERNAL JACOBI
C
C     _______________________________________________________
C
C*    Section 1. Initialise.
C     _______________________________________________________
C
  100 CONTINUE
C
      MAKERL = 0
C
C     Check truncation not too big to handle.
C
      IF( KTRUNC .GT. JPSTRUNC ) THEN
        CALL INTLOG(JP_FATAL,'MAKERL: Truncation max exceeded', JPQUIET)
        CALL INTLOG(JP_FATAL,'MAKERL: Truncation = ', KTRUNC)
        CALL INTLOG(JP_FATAL,'MAKERL: Allowed maximum = ', JPSTRUNC)
        MAKERL = JPROUTINE + 1
         GOTO 900
      ENDIF
C
C     _______________________________________________________
C
C*    Section 2. Rotate the spectral coefficients.
C     _______________________________________________________
C
  200 CONTINUE
C
#if (defined REAL_8)
      DLAT = -90.0 - RANGLES(1)
      DLON = -RANGLES(2)
C
C     Rotate the spectral field by longitude.
C     Positive DLON => frame rotated from west to east.
C
      DO 210 LOOP = 1, (KTRUNC+1)*(KTRUNC+2)
        SHCOUT(LOOP) = SHCIN(LOOP)
  210 CONTINUE
      CALL RPHI( SHCOUT, KTRUNC, WORK, DLON)
C
C     Rotate the spectral field by latitude.
C     Negative DLAT => rotate counter-clockwise about new polar axis.
C
      LOK = JACOBI( SHCOUT, KTRUNC, WORK, DLAT)
      IF(.NOT.LOK) THEN
        CALL INTLOG(JP_FATAL,'MAKERL: JACOBI failed.', JPQUIET)
        MAKERL = JPROUTINE + 2
         GOTO 900
      ENDIF
#else
      DLAT = -90.0 - DBLE(RANGLES(1))
      DLON = -DBLE(RANGLES(2))
C
C     Expand spectral coefficients to REAL*8
C
      DO 210 LOOP = 1, (KTRUNC+1)*(KTRUNC+2)
        DATA(LOOP) = DBLE(SHCIN(LOOP))
  210 CONTINUE
C
C     Rotate the spectral field by longitude.
C     Positive DLON => frame rotated from west to east.
C
      CALL RPHI( DATA, KTRUNC, WORK, DLON)
C
C     Rotate the spectral field by latitude.
C     Negative DLAT => rotate counter-clockwise about new polar axis.
C
      LOK = JACOBI( DATA, KTRUNC, WORK, DLAT)
      IF(.NOT.LOK) THEN
        CALL INTLOG(JP_FATAL,'MAKERL: JACOBI failed.', JPQUIET)
        MAKERL = JPROUTINE + 2
         GOTO 900
      ENDIF
C
C     Repack spectral coefficients to REAL*4.
C
      DO 220 LOOP = 1, (KTRUNC+1)*(KTRUNC+2)
        SHCOUT(LOOP) = SNGL(DATA(LOOP))
  220 CONTINUE
#endif
C
C     _______________________________________________________
C
C*    Section 9. Return.
C     _______________________________________________________
C
  900 CONTINUE
C
      RETURN
      END
