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 INTUVF( KVGRIB, KDGRIB, INLEN,
     X                         KUGRIBO, KVGRIBO, OUTLEN)
C
C---->
C**** INTUVF
C
C     Purpose
C     -------
C
C     Interpolate input vorticity and divergence field to
C     U and V fields.
C
C
C     Interface
C     ---------
C
C     IRET = INTUVF( KVGRIB, KDGRIB, INLEN, KUGRIBO,KVGRIBO,OUTLEN)
C
C     Input
C     -----
C
C     KVGRIB - Input vorticity field  (spectral, GRIB format).
C     KDGRIB - Input divergence field (spectral, GRIB format).
C     INLEN  - Input field length (words).
C
C
C     Output
C     ------
C
C     KUGRIBO - Output U field (GRIB format).
C     KVGRIBO - Output V field (GRIB format).
C     OUTLEN  - Output field length (words).
C
C
C     Method
C     ------
C
C     Convert spectral vorticity/divergence to spectral U/V and then
C     interpolate U and V to output fields.
C
C
C     Externals
C     ---------
C
C     IBASINI - Ensure basic interpolation setup is done.
C     JVOD2UV - Converts spectral vorticity/divergence to spectral U/V.
C     JMEMHAN - Allocate/deallocate scratch memory.
C     INTFAU  - Prepare to interpolate unpacked input field.
C     INTFBU  - Interpolate unpacked input field.
C     INTLOG  - Log error message.
C     RESET_C - Reset interpolation handling options using GRIB product.
C     INSANE  - Ensure no outrageous values given for interpolation.
C
C
C     Author
C     ------
C
C     J.D.Chambers     ECMWF     Jan 1995
C
C     J.D.Chambers     ECMWF        Feb 1997
C     Allow for 64-bit pointers
C
C----<
C     -----------------------------------------------------------------|
C
      IMPLICIT NONE
C
C     Function arguments
C
      INTEGER KVGRIB(*), KDGRIB(*), INLEN
      INTEGER KUGRIBO(*), KVGRIBO(*), OUTLEN
C
#include "parim.h"
#include "nifld.common"
#include "nofld.common"
#include "grfixed.h"
#include "intf.h"
C
C     Parameters
C
      INTEGER JPROUTINE, JPALLOC, JPDEALL, JPSCR3, JPSCR4
      PARAMETER (JPROUTINE = 26800 )
      PARAMETER (JPALLOC = 1) 
      PARAMETER (JPDEALL = 0) 
      PARAMETER (JPSCR3 = 3) 
      PARAMETER (JPSCR4 = 4) 
C
C     Local variables
C
      INTEGER IERR, KPR, ISZVD, ISZUV, IWORD, ISAME
      INTEGER IPVORT, IPDIV, IP_U, IP_V
#ifndef _CRAYFTN
#ifdef POINTER_64
      INTEGER*8 IUV
      INTEGER*8 IVD
#endif
#endif
      REAL UV, VD
      POINTER ( IUV, UV )
      POINTER ( IVD, VD )
      DIMENSION UV( 1 ), VD( 1 )
C
C     Externals
C
      INTEGER INTFAU, INTFBU, RESET_C
      INTEGER IBASINI, INSANE
C
C     -----------------------------------------------------------------|
C*    Section 1.   Initialise
C     -----------------------------------------------------------------|
C
  100 CONTINUE
      INTUVF = 0
      IERR = 0
      KPR = 0
C
C     Ensure that basic initialisation has been done
C
      IERR = IBASINI(0)
      IF( IERR.NE.0 ) THEN
        CALL INTLOG(JP_ERROR,'INTUVF: basic initialise failed',JPQUIET)
        INTUVF = IERR
        GOTO 900
      ENDIF
C
C     -----------------------------------------------------------------|
C*    Section 2.   Unpack the vorticity/divergence fields.
C     -----------------------------------------------------------------|
C
  200 CONTINUE
C
C     Get scratch memory for vorticity/divergence unpacked fields.
C     Vorticity/divergence memory areas are adjacent.
C
C     Need to establish input truncation, so unpack GRIB sections 1
C     and 2.
C
      IERR = 1
      CALL GRIBEX(ISEC0, ISEC1, ISEC2, ZSEC2, ISEC3, ZSEC3, ISEC4,
     X            VD(IPVORT), ISZVD, KVGRIB, INLEN, IWORD, 'I',IERR)
      IF( IERR.NE.0 ) THEN
        CALL INTLOG(JP_ERROR,'INTUVF: GRIBEX decoding failed.',IERR)
        INTUVF = IERR
        GOTO 900
      ENDIF
C
      NIRESO = ISEC2(2)
      ISZVD = (NIRESO+1)*(NIRESO+2)
      IPVORT = 1
      IPDIV  = 1 + ISZVD
      CALL JMEMHAN( JPSCR4, IVD, ISZVD*2, JPALLOC, IERR)
      IF( IERR.NE.0 ) THEN
        CALL INTLOG(JP_ERROR,'INTUVF: Memory allocation fail.',JPQUIET)
        INTUVF = IERR
        GOTO 900
      ENDIF
C
C     Decode data from GRIB code (no checking)
C     Vorticity ...
C
      IWORD = INLEN
      IERR  =  0
      CALL GRSVCK(0)
      IERR = 1
      ISEC3(2) = NINT(RMISSGV)
      ZSEC3(2) = RMISSGV
      CALL GRIBEX(ISEC0, ISEC1, ISEC2, ZSEC2, ISEC3, ZSEC3, ISEC4,
     X            VD(IPVORT), ISZVD, KVGRIB, INLEN, IWORD, 'D',IERR)
      IF( IERR.NE.0 ) THEN
        CALL INTLOG(JP_ERROR,'INTUVF: GRIBEX decoding failed.',IERR)
        INTUVF = IERR
        GOTO 900
      ENDIF
C
C     Divergence ...
C
      IERR = 1
      ISEC3(2) = NINT(RMISSGV)
      ZSEC3(2) = RMISSGV
      CALL GRIBEX(ISEC0, ISEC1, ISEC2, ZSEC2, ISEC3, ZSEC3, ISEC4,
     X            VD(IPDIV), ISZVD, KDGRIB, INLEN, IWORD, 'D',IERR)
      IF( IERR.NE.0 ) THEN
        CALL INTLOG(JP_ERROR,'INTUVF: GRIBEX decoding failed.',IERR)
        INTUVF = IERR
        GOTO 900
      ENDIF
C
C     Setup interpolation options from input GRIB characteristics.
C
      IERR = RESET_C( ISEC1, ISEC2, ZSEC2, ISEC4)
      IF( IERR.NE.0 ) THEN
        CALL INTLOG(JP_ERROR,
     X    'INTUVF: Setup interp. options from GRIB failed.',JPQUIET)
        INTUVF = IERR
        GOTO 900
      ENDIF
C
C     Check that no outrageous values given for interpolation
C
      ISAME = INSANE()
      IF( ISAME.GT.0 ) THEN
        CALL INTLOG(JP_ERROR,
     X    'INTUVF: Interpolation cannot use given values.',JPQUIET)
        INTUVF = ISAME
        GOTO 900
      ENDIF
C
C     -----------------------------------------------------------------|
C*    Section 3.   Convert spectral vorticity/divergence
C                  to spectral U/V
C     -----------------------------------------------------------------|
C
  300 CONTINUE
C
C     Get scratch memory for U and V spectral fields.
C     U and V memory areas are adjacent.
C
      ISZUV = (NIRESO+1)*(NIRESO+4)
      IP_U = 1
      IP_V = 1 + ISZUV
      CALL JMEMHAN( JPSCR3, IUV, ISZUV*2, JPALLOC, IERR)
      IF( IERR.NE.0 ) THEN
        CALL INTLOG(JP_ERROR,'INTUVF: Memory allocation fail.',JPQUIET)
        INTUVF = IERR
        GOTO 900
      ENDIF
C
C     Generate U and V with same truncation as input fields.
C
      CALL JVOD2UV( VD(IPVORT), VD(IPDIV), NIRESO,
     X              UV(IP_U), UV(IP_V), NIRESO)
C
C     -----------------------------------------------------------------|
C*    Section 4.   Interpolate U field.
C     -----------------------------------------------------------------|
C
  400 CONTINUE
C
C     Prepare to interpolate U field.
C
      NIFORM = 0
      IERR = INTFAU( UV(IP_U), ISZUV, KUGRIBO, OUTLEN)
      IF( IERR.NE.0 ) THEN
        CALL INTLOG(JP_ERROR,
     X    'INTUVF: Prepare to interpolate failed.',IERR)
        INTUVF = IERR
        GOTO 900
      ENDIF
C
C     Interpolate U field.
C
      IERR = INTFBU( UV(IP_U), ISZUV, KUGRIBO, OUTLEN)
C
      IF( IERR.NE.0 ) THEN
        CALL INTLOG(JP_ERROR,'INTUVF: Interpolation failed.',JPQUIET)
        INTUVF = IERR
        GOTO 900
      ENDIF
C
C     -----------------------------------------------------------------|
C*    Section 5.   Interpolate V field.
C     -----------------------------------------------------------------|
C
  500 CONTINUE
C
C     Prepare to interpolate V field.
C
      IERR = INTFAU( UV(IP_V), ISZUV, KVGRIBO, OUTLEN)
      IF( IERR.NE.0 ) THEN
        CALL INTLOG(JP_ERROR,
     X    'INTUVF: Prepare to interpolate failed.',JPQUIET)
        INTUVF = IERR
        GOTO 900
      ENDIF
C
C     Interpolate V field.
C
      IERR = INTFBU( UV(IP_V), ISZUV, KVGRIBO, OUTLEN)
C
      IF( IERR.NE.0 ) THEN
        CALL INTLOG(JP_ERROR,
     X    'INTUVF: Prepare to interpolate failed.',JPQUIET)
        INTUVF = IERR
        GOTO 900
      ENDIF
C
C     -----------------------------------------------------------------|
C*    Section 9.   Closedown.
C     -----------------------------------------------------------------|
C
  900 CONTINUE
C
C     Clear change flags for next product processing
C
      LCHANGE = .FALSE.
      LSMCHNG = .FALSE.
C
C     Return the scratch memory.
C
      CALL JMEMHAN( JPSCR3, IUV, ISZUV*2, JPDEALL, IERR)
      IF( IERR.NE.0 ) THEN
        CALL INTLOG(JP_ERROR,'INTUVF: Memory deallocation fail',JPQUIET)
        INTUVF = IERR
      ENDIF
C
      CALL JMEMHAN( JPSCR4, IVD, ISZVD*2, JPDEALL, IERR)
      IF( IERR.NE.0 ) THEN
        CALL INTLOG(JP_ERROR,'INTUVF: Memory deallocation fail',JPQUIET)
        INTUVF = IERR
      ENDIF
C
      RETURN
      END
