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 HNTFAUH(FLDIN,INLEN)
C
C---->
C**** HNTFAUH
C
C     Purpose
C     -------
C
C     Prepare to interpolate input field...
C
C
C     Interface
C     ---------
C
C     IRET = HNTFAUH( FLDIN,INLEN)
C
C     Input
C     -----
C
C     FLDIN  - Input field (unpacked).
C     INLEN  - Input field length (words).
C
C
C     Output
C     ------
C
C     Field unpacked values are in ZNFELDI, rotated if necessary.
C
C     Returns: 0, if OK. Otherwise, an error occured in interpolation.
C
C
C     Method
C     ------
C
C     If the input is a spectral field and the output is a rotated
C     grid-point field, create a global reduced gaussian field and
C     then create the rotated grid-point field from it.
C
C
C     Externals
C     ---------
C
C     INTLOG  - Log error message.
C     INTLOGR - Log error message.
C     JDEBUG  - Checks environment to switch on/off debug
C     FIXAREA - Fixup input/output field area definitions.
C     HSP2GG  - Find suitable gaussian grid for spectral truncation
C     HIRLAM  - Creates rotated lat/long field from reduced gaussian
C     HIRLSM  - Creates rotated lat/long field from reduced gaussian
C               using land-sea mask
C     HRG2GG  - Creates rotated gaussian field from reduced gaussian
C     LSMFLD  - Determines whether a field is to be interpolated using
C               a land-sea mask
C
C
C     Author
C     ------
C
C     J.D.Chambers     ECMWF     February 2001
C
C----<
C
C     -----------------------------------------------------------------|
C*    Section 0.   Variables
C     -----------------------------------------------------------------|
C
      IMPLICIT NONE
C
C     Function arguments
C
      INTEGER INLEN
      REAL FLDIN(*)
C
#include "parim.h"
#include "nifld.common"
#include "nofld.common"
#include "grfixed.h"
#include "intf.h"
#include "jparams.h"
#include "current.h"
#include "intlog.h"
C
C     Parameters
C
      INTEGER JPROUTINE
      PARAMETER (JPROUTINE = 40150 )
      INTEGER JPLEN, JPNM
      PARAMETER ( JPNM = JPSTRUNC )
      PARAMETER ( JPLEN = (JPNM+1)*(JPNM+2) )
C
C     Local variables
C
      LOGICAL LUSELSM, LSP2RGG, LLATOUT
      INTEGER NUMPTS, NGAUSS, NLON, NLAT, NUVFLAG, NTRUNC, NCOUNT
      INTEGER IWORD, IERR, LOOP, IRET, ISIZE, KPTS(JPGTRUNC*2)
      INTEGER ISHIZE
      INTEGER ITEMP,K,I,J,IM,JM
      REAL PLATS(JPGTRUNC*2),AREA(4),GRID(2),POLE(2),WEST,EAST

C     REAL TEMP(1440,1440): EMOS-113: changed to dynamic memory allocation
      REAL TEMP(1536,1536)

      CHARACTER*1 HOLDTYP
C
      REAL SWORK(1), RGGRID(1), ZNFLDO(1)
#ifndef _CRAYFTN
#ifdef POINTER_64
      INTEGER*8 ISWORK, IRGGRID, IZNFLDO
#endif
#endif
      POINTER ( ISWORK, SWORK)
      POINTER ( IRGGRID, RGGRID)
      POINTER ( IZNFLDO, ZNFLDO )
C
      SAVE IZNFLDO, ISWORK, IRGGRID
C
C     Externals
C
      INTEGER HSP2GG, HIRLAM, HIRLSM, HRG2GG, FIXAREA, PDDEFS
      INTEGER HSP2GG2,HSP2GG3
      LOGICAL LSMFLD
C
      REAL POLELAT, POLELON
      CHARACTER*1 TYPE
      INTEGER NBYTES, ITRUNC
      DATA ISIZE/0/
C
C     -----------------------------------------------------------------|
C*    Section 1.   Initialise
C     -----------------------------------------------------------------|
C
  100 CONTINUE
C
      HNTFAUH = 0
      IRET    = 0
C
      NCOUNT = INLEN
C
C     -----------------------------------------------------------------|
C*    Section 2.   Store input data.
C     -----------------------------------------------------------------|
C
  200 CONTINUE
C
C     Allocate work array ZNFELDI if not already done.
C
      IF( IZNJDCI.NE.1952999238 ) THEN
        CALL JMEMHAN( 19, IZNFLDI, JPEXPAND, 1, IRET)
        IF( IRET.NE.0 ) THEN
          CALL INTLOG(JP_WARN,'HNTFAUH: ZNFELDI allocate fail',JPQUIET)
          HNTFAUH = IRET
          GOTO 900
        ENDIF
        IZNJDCI = 1952999238
      ENDIF
C
C     Move unpacked values in from user array
C
      DO LOOP = 1, INLEN
        ZNFELDI( LOOP ) = FLDIN( LOOP )
      ENDDO
      IF (NISCNM.EQ.64) THEN
        CALL INTLOG(JP_DEBUG,
     X    'HNTFAUH: Scanning flag west-east/south-north',NISCNM)
        ITEMP = NIAREA(1)
        NIAREA(1) = NIAREA(3)
        NIAREA(3) = ITEMP


        IM = NIWE
        JM = NINS
        K=0
        DO J=JM,1,-1
          DO I=1,IM
            K=K+1
              TEMP(I,J) = ZNFELDI(K)
          END DO
        END DO
        K=0
        DO J=1,JM
          DO I=1,IM
            K=K+1
              ZNFELDI(K) = TEMP(I,J)
          END DO
        END DO


      ENDIF
C
      LLATOUT = (NOREPR.EQ.JPREGROT).OR.(NOREPR.EQ.JPREGULAR)
C     -----------------------------------------------------------------|
C*    Section 3.   Handle rotation, if necessary.
C     -----------------------------------------------------------------|
C
  300 CONTINUE
C
C     Is rotation required?
C
      IF( LNOROTA ) THEN
C
        IF( LDEBUG ) THEN
          CALL INTLOG(JP_DEBUG,'HNTFAUH: Rotate field.',JPQUIET)
          CALL INTLOG(JP_DEBUG,'HNTFAUH: South pole lat  ',NOROTA(1))
          CALL INTLOG(JP_DEBUG,'HNTFAUH: South pole long ',NOROTA(2))
        ENDIF
C
C       Fill area limits (handles case when default 0/0/0/0 given)
C
        IRET = FIXAREA()
        IF( IRET.NE.0 ) THEN
          IF( LDEBUG ) CALL INTLOG(JP_ERROR,
     X      'HNTFAUH: area fixup failed',JPQUIET)
          HNTFAUH = JPROUTINE + 3
          GOTO 900
        ENDIF
C
        AREA(1) = REAL(NOAREA(1))/PPMULT
        AREA(2) = REAL(NOAREA(2))/PPMULT
        AREA(3) = REAL(NOAREA(3))/PPMULT
        AREA(4) = REAL(NOAREA(4))/PPMULT
C
        GRID(1) = REAL(NOGRID(1))/PPMULT
        GRID(2) = REAL(NOGRID(2))/PPMULT
C
        POLE(1) = REAL(NOROTA(1))/PPMULT
        POLE(2) = REAL(NOROTA(2))/PPMULT
C
C     -----------------------------------------------------------------|
C*    Section 4.   Spectral to rotated grid-point
C     -----------------------------------------------------------------|
C
  400   CONTINUE
C
        LSP2RGG = .FALSE.
      IF( (NIREPR.EQ.JPSPHERE).OR.(NIREPR.EQ.JPSPHROT) ) THEN
C
C         Convert spectral to suitable global reduced gaussian grid
C
          IF( LDEBUG ) CALL INTLOG(JP_DEBUG,
     X      'HNTFAUH: Spectral to suitable reduced gaussian',JPQUIET)
C
          NTRUNC = NIRESO
c---------------------------------------------------------------------
      IF(LNORESO) THEN
         NTRUNC = NORESO
         IRET = HSP2GG(NTRUNC,NGAUSS,KPTS,PLATS,ISIZE)
          IF( IRET.NE.0 ) THEN
            IF( LDEBUG ) CALL INTLOG(JP_ERROR,
     X        'HNTFAUH: problem getting data for reduced grid',NTRUNC)
            HNTFAUH = JPROUTINE + 4
            GOTO 900
          ENDIF
         IF( LDEBUG ) THEN
          CALL INTLOG(JP_DEBUG,'HNTFAUH: Spectral truncation:', NTRUNC)
          CALL INTLOG(JP_DEBUG,'HNTFAUH: Gaussian number : ',NGAUSS)
         ENDIF
        GOTO 401
       ENDIF

       IF(LARESOL ) THEN
        IF(LLATOUT) THEN
         IRET = HSP2GG2(NTRUNC,GRID(1),GRID(2),NGAUSS,KPTS,PLATS,ISIZE)
        ELSE
         IRET = HSP2GG3(NTRUNC,NGAUSS,KPTS,PLATS,ISIZE)
        ENDIF
         IF( IRET.NE.0 ) THEN
           IF( LDEBUG ) CALL INTLOG(JP_ERROR,
     X       'HNTFAUH: problem getting data for reduced grid',NTRUNC)
           HNTFAUH = JPROUTINE + 4
           GOTO 900
         ENDIF
       ENDIF
c---------------------------------------------------------------------
cs            IRET = HSP2GG(NTRUNC,NGAUSS,KPTS,PLATS,ISIZE)
cs            IF( IRET.NE.0 ) THEN
cs              IF( LDEBUG ) CALL INTLOG(JP_ERROR,
cs     X         'HNTFAUH: problem getting data for reduced gridl',NTRUNC)
cs              HNTFAUH = JPROUTINE + 4
cs              GOTO 900
cs            ENDIF

cs         NCOUNT = ISIZE
c---------------------------------------------------------------------
C       Truncate if a smaller resolution has been requested
C
  401 CONTINUE
      IF( NTRUNC.LT.NIRESO ) THEN
       IF( LDEBUG ) THEN
       CALL INTLOG(JP_DEBUG,'HNTFAUH: Truncation changed from: ',NIRESO)
       CALL INTLOG(JP_DEBUG,'HNTFAUH: to: ',NTRUNC)
       CALL INTLOG(JP_DEBUG,'HNTFAUH: Gaussian number is : ',NGAUSS)
       ENDIF
C
            ISHIZE =  (NTRUNC+1)*(NTRUNC+4)
              CALL JMEMHAN( 3, IZNFLDO, ISHIZE, 1, IERR)
              IF( IERR.NE.0 ) THEN
                CALL INTLOG(JP_FATAL,
     X            'HNTFAUH: Get scratch space failed',JPQUIET)
                HNTFAUH = JPROUTINE + 4
                GOTO 900
              ENDIF
C
C         Generate spherical harmonics with output truncation
C
          CALL SH2SH( ZNFELDI, NIRESO, ZNFLDO, NTRUNC )
C
C         Move new spherical harmonics to 'input' array
C
          DO LOOP = 1, ISHIZE
            ZNFELDI(LOOP) = ZNFLDO(LOOP)
          ENDDO

      ELSE
C
          IF( LDEBUG ) CALL INTLOG(JP_DEBUG,
     X      'HNTFAUH: Spectral to suitable reduced gaussian',JPQUIET)
C
          NTRUNC = NIRESO
          IRET = HSP2GG(NTRUNC,NGAUSS,KPTS,PLATS,ISIZE)
          IF( IRET.NE.0 ) THEN
            IF( LDEBUG ) CALL INTLOG(JP_ERROR,
     X        'HNTFAUH: problem getting data for reduced grid',NTRUNC)
            HNTFAUH = JPROUTINE + 4
            GOTO 900
          ENDIF
         IF( LDEBUG ) THEN
          CALL INTLOG(JP_DEBUG,'HNTFAUH: Spectral truncation:', NTRUNC)
          CALL INTLOG(JP_DEBUG,'HNTFAUH: Gaussian number : ',NGAUSS)
         ENDIF
       ENDIF
c---------------------------------------------------------------------
C
C         Dynamically allocate memory for global reduced gaussian grid
C
          CALL JMEMHAN( 18, IRGGRID, ISIZE, 1, IRET)
          IF( IRET.NE.0 ) THEN
            IF( LDEBUG ) CALL INTLOG(JP_ERROR,
     X        'HNTFAUH: memory alloc for reduced grid fail',JPQUIET)
            HNTFAUH = JPROUTINE + 4
            GOTO 900
          ENDIF
C
C         Set flag to show field is not a wind component
C
          NUVFLAG = 0
C
C         Create the reduced gaussian grid
C
          HOLDTYP = HOGAUST
          WEST = 0.0
          EAST = 360.0 - (360.0/(NGAUSS*4))
          CALL JAGGGP(ZNFELDI,NTRUNC,PLATS(1),PLATS(NGAUSS*2),WEST,
     X                EAST,NGAUSS,'R',KPTS,RGGRID,NUVFLAG,IRET)
          IF( IRET.NE.0 ) THEN
            IF( LDEBUG ) CALL INTLOG(JP_ERROR,
     X        'HNTFAUH: spectral to reduced gaussian failed',JPQUIET)
            HNTFAUH = JPROUTINE + 4
            GOTO 900
          ENDIF
          HOGAUST = HOLDTYP

        NCOUNT = 0
        DO LOOP = 1, (NGAUSS*2)
          NCOUNT= NCOUNT + KPTS(LOOP)
        ENDDO
C
          LSP2RGG = .TRUE.
C
C     -----------------------------------------------------------------|
C*    Section 5.   Complete the spectral to rotated lat/long
C     -----------------------------------------------------------------|
C
  500     CONTINUE
C
          IF( NOREPR.EQ.JPREGROT ) THEN
            IF( LDEBUG ) CALL INTLOG(JP_DEBUG,
     X        'HNTFAUH: Convert gaussian to rotated lat/long',JPQUIET)
C
            GOTO 700
C
          ENDIF
C
C     -----------------------------------------------------------------|
C*    Section 6.   Complete the spectral to rotated gaussian
C     -----------------------------------------------------------------|
C
  600   CONTINUE
C
          IF( NOREPR.EQ.JPFGGROT ) THEN
            IF( LDEBUG ) CALL INTLOG(JP_DEBUG,
     X        'HNTFAUH: Convert gaussian to rotated gaussian',JPQUIET)
C
            GOTO 800
          ENDIF

        ENDIF
C
C     -----------------------------------------------------------------|
C*    Section 7.   Gaussian to rotated lat/long
C     -----------------------------------------------------------------|
C
  700   CONTINUE
C
        IF( (LSP2RGG.AND.(NOREPR.EQ.JPREGROT)) .OR.
     X      ( ((NIREPR.EQ.JPQUASI).OR.(NIREPR.EQ.JPGAUSSIAN)) .AND.
     X      (NOREPR.EQ.JPREGROT) ) ) THEN
          IF( LDEBUG )
     X      CALL INTLOG(JP_DEBUG,'HNTFAUH: Gauss to lat/lon',JPQUIET)
C
C         Dynamically allocate memory for rotated lat/long grid
C
          NLON = 1 + NINT(FLOAT((NOAREA(JPEAST)  - NOAREA(JPWEST))) /
     X           NOGRID(JPWESTEP))
          NLAT = 1 + NINT(FLOAT((NOAREA(JPNORTH) - NOAREA(JPSOUTH))) /
     X           NOGRID(JPNSSTEP))
C
          NUMPTS = NLON * NLAT
          ISIZE  = NUMPTS
          CALL JMEMHAN( 11, ISWORK, ISIZE, 1, IRET)
          IF( IRET.NE.0 ) THEN
            IF( LDEBUG ) CALL INTLOG(JP_ERROR,
     X        'HNTFAUH: memory alloc for lat/long grid fail',JPQUIET)
            HNTFAUH = JPROUTINE + 7
            GOTO 900
          ENDIF
C
          LUSELSM = LSMFLD()
C
C         If original field was spectral, ...
C
          IF( LSP2RGG ) THEN
            IF( LUSELSM ) THEN
              IRET = HIRLSM(LO12PT,RGGRID,NCOUNT,NGAUSS,AREA,POLE,GRID,
     X                      SWORK,ISIZE,NLON,NLAT)
            ELSE
              IRET = HIRLAM(LO12PT,RGGRID,NCOUNT,NGAUSS,AREA,POLE,GRID,
     X                      SWORK,ISIZE,NLON,NLAT)
            ENDIF
C
          ELSE
C
C         If original field was gaussian, ...
C
          IRET = PDDEFS()
            NGAUSS = NIGAUSS
cs            IF( LUSELSM ) THEN
            IF( LSM ) THEN
              IRET = HIRLSM(LO12PT,ZNFELDI,NCOUNT,NGAUSS,AREA,POLE,GRID,
     X                      SWORK,ISIZE,NLON,NLAT)
            ELSE
              IRET = HIRLAM(LO12PT,ZNFELDI,NCOUNT,NGAUSS,AREA,POLE,GRID,
     X                      SWORK,ISIZE,NLON,NLAT)
            ENDIF
C
          ENDIF
C
cs   setting size of output field
          OUTLROT = NLON * NLAT
          IF( IRET.NE.0 ) THEN
            IF( LDEBUG ) CALL INTLOG(JP_ERROR,
     X        'HNTFAUH: HIRLAM rotation failed',JPQUIET)
            HNTFAUH = JPROUTINE + 7
            GOTO 900
          ENDIF
C
        ENDIF
C
C     -----------------------------------------------------------------|
C*    Section 8.   Gaussian to rotated gaussian
C     -----------------------------------------------------------------|
C
  800   CONTINUE
C
        IF( (LSP2RGG.AND.(NOREPR.EQ.JPFGGROT)) .OR.
     X      (((NIREPR.EQ.JPQUASI).OR.(NIREPR.EQ.JPGAUSSIAN)) .AND.
     X      (NOREPR.EQ.JPFGGROT)) ) THEN
          IF( LDEBUG ) CALL INTLOG(JP_DEBUG,
     X      'HNTFAUH: Gaussian to reduced gaussian',JPQUIET)
C
C         Dynamically allocate memory for rotated lat/long grid
C
          ISIZE = NOGAUSS * NOGAUSS * 8 
          CALL JMEMHAN( 11, ISWORK, ISIZE, 1, IRET)
          IF( IRET.NE.0 ) THEN
            IF( LDEBUG ) CALL INTLOG(JP_ERROR,
     X        'HNTFAUH: memory alloc for gaussian grid fail',JPQUIET)
            HNTFAUH = JPROUTINE + 8
            GOTO 900
          ENDIF
C
C         If original field was spectral, ...
C
          IF( LSP2RGG ) THEN
            IRET = HRG2GG(LO12PT,RGGRID,NGAUSS,AREA,POLE,
     X                    NOGAUSS,HOGAUST,SWORK,ISIZE,NUMPTS)
C
          ELSE
C
C         If original field was gaussian, ...
C
            NGAUSS = NIGAUSS
            IRET = HRG2GG(LO12PT,ZNFELDI,NGAUSS,AREA,POLE,
     X                    NOGAUSS,HOGAUST,SWORK,ISIZE,NUMPTS)
          ENDIF
cs   setting size of output field
          OUTLROT = NUMPTS
          IF( IRET.NE.0 ) THEN
            IF( LDEBUG ) CALL INTLOG(JP_ERROR,
     X        'HNTFAUH: HRG2GG rotation failed',JPQUIET)
            HNTFAUH = JPROUTINE + 8
            GOTO 900
          ENDIF
C
        ENDIF
C
C     -----------------------------------------------------------------|
C*    Section 9.   Closedown.
C     -----------------------------------------------------------------|
C
C       Move rotated field back into field original array.
C
        DO LOOP = 1, NUMPTS
          ZNFELDI(LOOP) = SWORK(LOOP)
        ENDDO
C
      ENDIF
C
  900 CONTINUE
C
      RETURN
      END
