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 INTVECY(PUFIELD,PVFIELD,KASIZE,
     X                         PUOUT,PVOUT,OUTLEN)
C
C---->
C**** INTVECY
C
C     Purpose
C     -------
C     Interpolate U or V component fields to grid point.
C
C
C     Interface
C     ---------
C     IRET = INTVECY(PUFIELD,PVFIELD,KASIZE,
C    X               KUGRIB,KVGRIB,OUTLEN)
C
C     Input
C     -----
C     PUFIELD - U values.
C     PVFIELD - V values.
C     KASIZE  - Size of input arrays
C
C
C     Output
C     ------
C     PUOUT - Output wind U component field
C     PVOUT - Output wind V component field
C     OUTLEN - Output U field length (words).
C
C
C     Method
C     ------
C     None.
C
C
C     Externals
C     ---------
C     RESET_C - Reset interpolation handling options using GRIB product.
C     IBASINI - Ensure basic interpolation setup is done.
C     ISCRSZ  - Calculate number of values in generated field.
C     INTFAU  - Prepare to interpolate unpacked input field.
C     INTFBU  - Interpolate unpacked input field.
C     INTLOG  - Log error message.
C     MKFRAME - Create a 'frame' from a rectangular field.
C     INTUVGH - Interpolate GRIB U and V reduced gaussian to rotated GRIB
C               U and V.
C
C
C     Author
C     ------
C     S.Curic     ECMWF     December 2006
C
C
C----<
C     -----------------------------------------------------------------|
C
      IMPLICIT NONE
C
#include "parim.h"
#include "nifld.common"
#include "nofld.common"
#include "intf.h"
#include "current.h"
#include "intlog.h"
C
C     Parameters
C
      INTEGER JPROUTINE
      PARAMETER (JPROUTINE = 40170 )
C
C     Function arguments
C
      INTEGER KPARAM, KASIZE, OUTLEN
      REAL PUFIELD(KASIZE), PVFIELD(KASIZE), PUOUT(*), PVOUT(*)
C
C     Local variables
C
      LOGICAL LFRAME, LOLDWIND, LOMISSV
      INTEGER NPARAM, IRET, ILENF, NTRUNC, NGAUSS, ISIZE, NCOUNT
      INTEGER NUVFLAG, NLON, NLAT, NBYTES, NSIZE
      INTEGER IHOLD, ISAME
      INTEGER IN_U, IN_V
      INTEGER NUMPTS
      REAL DUMMY
      REAL AREA(4), GRID(2), POLE(2), EAST, WEST
      REAL OLDGRID(2)
      CHARACTER*1 HOLDTYP
      INTEGER LOOP
C
      REAL RGGRID, SWORK, TWORK
      POINTER (IRGGRID, RGGRID(1) )
      POINTER (ISWORK, SWORK(1) )
      POINTER (ITWORK, TWORK(1) )
C
      INTEGER KPTS(JPGTRUNC*2)
      REAL GLATS(JPGTRUNC*2)

      LOGICAL LFIRST, LNEWUV, LSPECUV
      CHARACTER*3 EXTRA
C
C     Externals
C
      INTEGER FIXAREA, INTFAU, INTFBU, INTUVDH, HSP2GG, IBASINI
      INTEGER HIRLAMW, ISCRSZ, RESET_C, INSANE, INTUVGH
      INTEGER HRG2GGW, HLL2LLW
C
      DATA IRGGRID/0/, ISWORK/0/, ITWORK/0/
      SAVE IRGGRID, ISWORK, ITWORK
      DATA LFIRST/.TRUE./, LNEWUV/.TRUE./, EXTRA/'NO '/
      SAVE LFIRST, LNEWUV
C
C     -----------------------------------------------------------------|
C*    Section 1.   Initialise.
C     -----------------------------------------------------------------|
C
  100 CONTINUE
C
      INTVECY = 0
      IF( LFIRST ) THEN
        CALL GETENV('IGNORE_UV_EXTRA_MODE', EXTRA)
        IF((EXTRA(1:1).EQ.'Y').OR.(EXTRA(1:1).EQ.'y')) LNEWUV = .FALSE.
        IF( LNEWUV ) THEN
          CALL INTLOG(JP_DEBUG,
     X      'INTVECY: IGNORE_UV_EXTRA_MODE not turned on',JPQUIET)
        ELSE
          CALL INTLOG(JP_DEBUG,
     X      'INTVECY: IGNORE_UV_EXTRA_MODE turned on',JPQUIET)
        ENDIF
        LFIRST = .FALSE.
      ENDIF
C
      LOLDWIND = LWINDSET
C
C     Ensure that basic initialisation has been done
C
      IRET = IBASINI(0)
      IF( IRET.NE.0 ) THEN
        CALL INTLOG(JP_ERROR,'INTVECY: basic initialise failed',JPQUIET)
        INTVECY = IRET
        GOTO 900
      ENDIF
C
C
cs      NSIZE = ISEC4(1)
      NSIZE = KASIZE
cs      NIREPR = ISEC2(1)
      LSPECUV = (NIREPR.EQ.JPSPHERE).OR.(NIREPR.EQ.JPSPHROT)
cs      IF( LSPECUV ) NIRESO = ISEC2(2)
C
C     Setup interpolation options from input GRIB characteristics.
C
cs      IRET = RESET_C(ISEC1, ISEC2, ZSEC2, ISEC4)
cs      IF( IRET.NE.0 ) THEN
cs        CALL INTLOG(JP_ERROR,
cs     X    'INTVECY: Setup interp. options from GRIB failed.',JPQUIET)
cs        INTVECY = IRET
cs        GOTO 900
cs      ENDIF
C
C       Only allowed rotations are:
C        - spectral to regular lat/long
C        - reduced gaussian to regular lat/long
C
      IF( LNOROTA ) THEN
        IF( ((NOREPR.NE.JPREGROT).AND.(NOREPR.NE.JPREGULAR)).OR.
     X      ((NIREPR.NE.JPSPHERE).AND.(NIREPR.NE.JPQUASI)) ) THEN
          CALL INTLOG(JP_ERROR,
     X      'INTVECY: For vector fields, only allowed rotations are:',
     X      JPQUIET)
          CALL INTLOG(JP_ERROR,
     X      'INTVECY: spectral to regular lat/long, or',JPQUIET)
          CALL INTLOG(JP_ERROR,
     X      'INTVECY: reduced gaussian to regular lat/long',JPQUIET)
          INTVECY = JPROUTINE + 1
          GOTO 900
        ENDIF
      ENDIF
C
C     Check that no outrageous values given for interpolation
C
      ISAME = INSANE()
      IF( (ISAME.GT.0).AND.(ISAME.NE.27261) ) THEN
        CALL INTLOG(JP_ERROR,
     X    'INTVECY: Interpolation cannot use given values.',JPQUIET)
        INTVECY = ISAME
        GOTO 900
      ENDIF
C
      LFRAME = LNOFRAME.AND.
     X         ((NOREPR.EQ.JPREGULAR).OR.(NOREPR.EQ.JPGAUSSIAN).OR.
     X          (NOREPR.EQ.JPREGROT ).OR.(NOREPR.EQ.JPFGGROT  ) )
C
C     Fill area limits (handles case when default 0/0/0/0 given)
C
      IRET = FIXAREA()
      IF( IRET.NE.0 ) THEN
        CALL INTLOG(JP_ERROR,'INTVECY: area fixup failed',JPQUIET)
        INTVECY = 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
      IF( LNOROTA ) THEN
        POLE(1) = REAL(NOROTA(1))/PPMULT
        POLE(2) = REAL(NOROTA(2))/PPMULT
        CALL INTLOG(JP_DEBUG,'INTVECY: Rotate the U & V fields',JPQUIET)
        CALL INTLOG(JP_DEBUG,'INTVECY: South pole lat  ',NOROTA(1))
        CALL INTLOG(JP_DEBUG,'INTVECY: South pole long ',NOROTA(2))
      ELSE
        NOROTA(1) = -9000000
        NOROTA(2) = 0
      ENDIF
C

      IF( .NOT. LSPECUV ) GOTO 500
C
C     Get some scratch memory for the U and V fields
C
C     Unpack U field
C
      NIFORM = 0
cs      NIPARAM = IN_U
      LWIND = .TRUE.
      LOLDWIND = LWINDSET
      LWINDSET = .TRUE.
C
cs      IN_U = ISEC1(6)
C
C     Unpack V field
C
cs      NIPARAM = IN_V
cs      IN_V = ISEC1(6)
C
      IF( LNOROTA ) GOTO 300
C
C     -----------------------------------------------------------------|
C*    Section 2.   Spectral to grid-point with no rotation
C     -----------------------------------------------------------------|
C
  200 CONTINUE
C
      CALL INTLOG(JP_DEBUG,
     X  'INTVECY: Interpolate U & V fields with no rotation',JPQUIET)
C
C
C     Interpolate U field
C
      IRET = INTFAU(PUFIELD, KASIZE)
      IF( IRET.NE.0 ) THEN
        CALL INTLOG(JP_ERROR,
     X    'INTVECY: Prepare to interpolate failed.',JPQUIET)
        INTVECY = JPROUTINE + 2
        GOTO 900
      ENDIF
C
      IRET = INTFBU(PUFIELD, KASIZE, PUOUT, OUTLEN)
      IF( IRET.NE.0 ) THEN
        CALL INTLOG(JP_ERROR,'INTVECY: Interpolation failed.',JPQUIET)
        INTVECY = JPROUTINE + 2
        GOTO 900
      ENDIF
C
C     Interpolate V field
C
      IRET = INTFAU(PVFIELD, KASIZE)
      IF( IRET.NE.0 ) THEN
        CALL INTLOG(JP_ERROR,
     X    'INTVECY: Prepare to interpolate failed.',JPQUIET)
        INTVECY = JPROUTINE + 2
        GOTO 900
      ENDIF
C
      IRET = INTFBU(PVFIELD, KASIZE, PVOUT, OUTLEN)
      IF( IRET.NE.0 ) THEN
        CALL INTLOG(JP_ERROR,'INTVECY: Interpolation failed.',JPQUIET)
        INTVECY = JPROUTINE + 2
        GOTO 900
      ENDIF
C
      GOTO 700
C
C     -----------------------------------------------------------------|
C*    Section 3.   Spectral to grid-point with rotation
C     -----------------------------------------------------------------|
C
  300 CONTINUE
C
      IF( .NOT.LUSEHIR ) THEN
        CALL INTLOG(JP_ERROR,
     X    'INTVECY : Unable to rotate spectral U or V:',JPQUIET)
        INTVECY  = JPROUTINE + 3
        GOTO 900
      ENDIF
C
C     Convert spectral to suitable global reduced gaussian
C
      NTRUNC = NIRESO
      IRET = HSP2GG(NTRUNC,NGAUSS,KPTS,GLATS,ISIZE)
      IF( IRET.NE.0 ) THEN
        CALL INTLOG(JP_ERROR,
     X    'INTVECY: problem getting data for reduced grid',NTRUNC)
        INTVECY = JPROUTINE + 4
        GOTO 900
      ENDIF
C
      NCOUNT = ISIZE
C
C     Dynamically allocate memory for global reduced gaussian grid
C
      CALL JMEMHAN( 18, IRGGRID, (NCOUNT*2), 1, IRET)
      IF( IRET.NE.0 ) THEN
        CALL INTLOG(JP_ERROR,
     X    'INTVECY: memory alloc for reduced grid fail',JPQUIET)
        INTVECY = JPROUTINE + 4
        GOTO 900
      ENDIF
C
C     Set flag to show field is a wind component
C
      NUVFLAG = 1
C
C     Create the reduced gaussian grid
C
      HOLDTYP = HOGAUST
      WEST = 0.0
      EAST = 360.0 - (360.0/(NGAUSS*4))
C
C     U component spectral -> reduced gaussian
C
      CALL JAGGGP(PUFIELD,NTRUNC,GLATS(1),GLATS(NGAUSS*2),WEST,
     X            EAST,NGAUSS,'R',KPTS,RGGRID,NUVFLAG,IRET)
      IF( IRET.NE.0 ) THEN
        CALL INTLOG(JP_ERROR,
     X    'INTVECY: spectral to reduced gaussian failed',JPQUIET)
        INTVECY = JPROUTINE + 4
        GOTO 900
      ENDIF
C
      HOGAUST = HOLDTYP
C
C     V component spectral -> reduced gaussian
C
      CALL JAGGGP(PVFIELD,NTRUNC,GLATS(1),GLATS(NGAUSS*2),WEST,
     X            EAST,NGAUSS,'R',KPTS,RGGRID(1+NCOUNT),NUVFLAG,IRET)
      IF( IRET.NE.0 ) THEN
        CALL INTLOG(JP_ERROR,
     X    'INTVECY: spectral to reduced gaussian failed',JPQUIET)
        INTVECY = JPROUTINE + 4
        GOTO 900
      ENDIF
C
      HOGAUST = HOLDTYP
C
C     Rotate using 12-point horizontal interpolation
C
C     Dynamically allocate memory for rotated lat/long grid
C
      NLON = 1 + NINT((AREA(JPEAST)  - AREA(JPWEST)) /
     X       GRID(JPWESTEP))                  ! SC
      NLAT = 1 + NINT((AREA(JPNORTH) - AREA(JPSOUTH)) /
     X       GRID(JPNSSTEP))                  ! SC
C
      OUTLEN = NLON * NLAT
C
      IRET = HIRLAMW(LO12PT,RGGRID,RGGRID(1+NCOUNT),NCOUNT,NGAUSS,AREA,
     X               POLE,GRID,PUOUT,PVOUT,OUTLEN,NLON,NLAT)
C
      IF( IRET.NE.0 ) THEN
        CALL INTLOG(JP_ERROR,
     X    'INTVECY: HIRLAMW rotation failed',JPQUIET)
        INTVECY = JPROUTINE + 6
        GOTO 900
      ENDIF
C
C     Set the components flag for rotated U and V coefficients
C
cs      ISEC2(19) = 8
      NOWE = NLON
      NONS = NLAT
      OUTLEN = NLAT*NLON

C
      GOTO 700
C
C     -----------------------------------------------------------------|
C*    Section 5.   Grid to grid  point
C     -----------------------------------------------------------------|
C
  500 CONTINUE
C*    5a.   Generate interpolated lat/long U and V fields.
C     -----------------------------------------------------------------|
C
C
      IF( (NOREPR.EQ.JPREGULAR).OR.(NOREPR.EQ.JPREGROT) ) THEN
C
C       Dynamically allocate scrath space 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
        NOWE = NLON
        NONS = NLAT
        OUTLEN = NLON * NLAT
C
C       Rotate reduced gaussian to lat/long
C
        IF( (NIREPR.EQ.JPGAUSSIAN).OR.(NIREPR.EQ.JPQUASI) ) THEN
        IF( LDEBUG ) CALL INTLOG(JP_DEBUG,
     X    'INTVECY: Rotate reduced gaussian to lat/long',JPQUIET)
          IRET = HIRLAMW(LO12PT,
     X                   PUFIELD,PVFIELD,KASIZE,
     X                   NIGAUSS,AREA,POLE,GRID,
     X                   PUOUT,PVOUT,OUTLEN,NLON,NLAT)
          IF( IRET.NE.0 ) THEN
            CALL INTLOG(JP_ERROR,
     X        'INTUVGH: HIRLAMW rotation failed',JPQUIET)
            INTUVGH = JPROUTINE + 3
            GOTO 900
          ENDIF
C
C       Rotate lat/long to lat/long
C
        ELSE
        IF( LDEBUG ) CALL INTLOG(JP_DEBUG,
     X    'INTVECY: Rotate lat/long to lat/long',JPQUIET)
          OLDGRID(1) = REAL(NIGRID(1)) / PPMULT
          OLDGRID(2) = REAL(NIGRID(2)) / PPMULT
          IRET = HLL2LLW(LO12PT,PUFIELD,PVFIELD,
     X                   OLDGRID,AREA,POLE,GRID,
     X                   PUOUT,PVOUT,OUTLEN,NLON,NLAT)
          IF( IRET.NE.0 ) THEN
            CALL INTLOG(JP_ERROR,
     X        'INTVECY: HLL2LLW rotation failed',JPQUIET)
            INTVECY = JPROUTINE + 3
            GOTO 900
          ENDIF
        ENDIF
C
      ELSE
C
C*    Section 5b.   Generate interpolated gaussian U and V fields.
C     -----------------------------------------------------------------|
C
  400   CONTINUE
C
        IF( LDEBUG ) CALL INTLOG(JP_DEBUG,
     X    'INTVECY: Rotate gaussian to gaussian',JPQUIET)
C
C       Dynamically allocate memory for rotated gaussian grids
C
        NUMPTS = NOGAUSS * NOGAUSS
        OUTLEN = 2 * NUMPTS * 8 
C
cs        NGAUSS = ISEC2(10)
        IRET = HRG2GGW(LO12PT,
     X                 PUFIELD,PVFIELD,KASIZE,
     X                 NIGAUSS,AREA,POLE,NOGAUSS,HOGAUST,
     X                 PUOUT,PVOUT,OUTLEN,NUMPTS)
        IF( IRET.NE.0 ) THEN
          IF( LDEBUG ) CALL INTLOG(JP_ERROR,
     X        'INTVECY: HRG2GGW rotation failed',JPQUIET)
            INTUVGH = JPROUTINE + 4
            GOTO 900
          ENDIF
C
      ENDIF
C
C
  700 CONTINUE
C
C     Reset the input format flag
C
cs      NIFORM = 1
C
C     If a 'frame' has been specified, build the frame
C
      IF( LFRAME ) THEN
        LOMISSV = LIMISSV
        LIMISSV = .TRUE.
        ISEC1(5) = 192
        ISEC3(2) = NINT(RMISSGV)
        ZSEC3(2) = RMISSGV
        CALL MKFRAME(NLON,NLAT,PUOUT,RMISSGV,NOFRAME)
        CALL MKFRAME(NLON,NLAT,PVOUT,RMISSGV,NOFRAME)
        LIMISSV = LOMISSV
      ENDIF

      DO 910 LOOP = 1, 4
        NOAAPI(LOOP) = NOAREA(LOOP)
  910 CONTINUE
C
C     -----------------------------------------------------------------|
C*    Section 9.   Return
C     -----------------------------------------------------------------|
C
  900 CONTINUE
C
      RETURN
      END
