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 WV2DXXX(ISEC2,ISEC4,NLATS,STEPNS,STEPWE,
     X                         OLDWAVE,NEWIDX,NEWWAVE,NORTH,WEST,PMISS)
C
C---->
C*****WV2DXXX*
C
C     PURPOSE
C     -------
C
C     Interpolates 2D wave spectra fields.
C
C
C     INTERFACE
C     ---------
C
C     IRET = WV2DXXX(ISEC2,ISEC4,NLATS,STEPNS,STEPWE,
C    X               OLDWAVE,NEWIDX,NEWWAVE,NORTH,WEST,PMISS)
C
C     Input arguments
C     ---------------
C
C     ISEC2   - Unpacked section 2 header from 2D wave spectra field
C     ISEC4   - Unpacked section 4 header from 2D wave spectra field
C     NLATS   - Number of points N-S in new grid
C     STEPNS  - Output grid north-south resolution (degrees)
C     STEPWE  - Output grid west-east resolution (degrees)
C     OLDWAVE - Original wave field
C     NORTH   - Output grid northernmost latitude (degrees)
C     WEST    - Output grid westernmost longitude (degrees)
C     PMISS   - Missing data value 
C
C     Output arguments
C     ----------------
C
C     NEWIDX  - Indices of old grid points used for new grid points
C     NEWWAVE - New wave field
C
C     Function returns 0 if the interpolation was OK.
C
C
C     METHOD
C     ------
C
C     Builds the index of nearest neighbour points for the output grid.
C     Then works through the output grid points, checking for subarea
C     boundaries and looking up nearset neighbour 2D spectra values
C     (which may be missing data).
C
C
C     EXTERNALS
C     ---------
C
C     WV2DIDX - builds the index of nearest neighbour points
C     NUMPTWE - Calculates number of grid points between west/east
C               area boundaries
C     VALPINA - Looks up bitmap value
C     ONEBITS - Counts number of 1s in a GRIB section 3 bitmap
C     NUMVALS - Counts the values in the secondary bitmap.
C     SOFFSET - Finds the section offsets in GRIB message
C     INTLOG  - Log error message
C
C
C     REFERENCE
C     ---------
C
C     None.
C
C
C     Author.
C     -------
C
C     J.D.Chambers      ECMWF    November 1996
C
C
C     Modifications
C     -------------
C
C     J.D.Chambers      ECMWF    April 1998
C     Handle parameter 251 as a simple form of wave 2D spectra.
C     (A field containing one direction and one frequency).
C
C
C----<
C
      IMPLICIT NONE
C
C     Subroutine arguments
C
      INTEGER ISEC2, ISEC4, NLATS
      DIMENSION ISEC2(*), ISEC4(*)
      REAL STEPNS, STEPWE, OLDWAVE, NEWWAVE, NORTH, WEST, PMISS
      DIMENSION OLDWAVE(*), NEWWAVE(*)
      INTEGER NEWIDX
      DIMENSION NEWIDX(*)
C
C     Parameters
C
      INTEGER JPROUTINE, JPMXLAT, JPNSPEC
      PARAMETER (JPROUTINE = 40000)
      PARAMETER (JPMXLAT = 1801)
      PARAMETER (JPNSPEC = 600)
C
C     Local arguments
C
      LOGICAL LSIMPLE
      INTEGER IEOFSET, IWOFSET, ISTART, IWEST
      REAL SOUTH, EAST, PTLAT, PTLONG, AWEST, OLDWEST, OLDEAST
      REAL REFVAL, SCALE
      INTEGER NPDATA, INSPT, NEXP, NMANT, NRETA, NRETB, NLENG, NBIT
      INTEGER NVALS
      INTEGER ISCALE, NSCALE, IBITS, ITEMP, NPBTMP2, IBITMAP, NUNUSED
      DIMENSION IBITMAP(JPNSPEC)
      INTEGER IRET, IS0, IS1, IS2, IS3, IS4, IEDITN
      INTEGER NEXT, NEXTWV, NROW, NCOL, INDEX, ILOCATE
      INTEGER NSPEC, MISSLAT, LOOP, NPTS, NUMLATS, NUMNEW
      INTEGER KOLDNUM, KNEWNUM
      DIMENSION NPTS(JPMXLAT), NUMNEW(JPMXLAT)
      REAL RLATINC, OLDLATS, NEWLATS, ROWINC
      DIMENSION OLDLATS(JPMXLAT), NEWLATS(JPMXLAT)
C
C     Externals
C
      INTEGER WV2DIDX, SOFFSET, VALPINA, NUMVALS, ONEBITS, NUMPTWE
      EXTERNAL WV2DIDX, SOFFSET, VALPINA, NUMVALS, ONEBITS, NUMPTWE
C
#include "parim.h"
#include "nifld.common"
#include "nofld.common"
#include "grspace.h"
C
C ---------------------------------------------------------------------
C*    Section 1. Initalisation.
C ---------------------------------------------------------------------
C
  100 CONTINUE
C
      WV2DXXX = 0
C
C     Initialise the bitmap value lookup function and function
C     which counts the values in the secondary bitmap.
C
      IRET = VALPINA(0,0,0)
      IRET = NUMVALS(0,0,0)
C
C     Setup number of spectra at each point
C
      IF( ISEC4(8).EQ.0 ) THEN
        LSIMPLE = .TRUE.
        NSPEC   = 1
      ELSE
        LSIMPLE = .FALSE.
        NSPEC   = ISEC4(50)*ISEC4(51)
      ENDIF
C
      IF( NSPEC.GT.JPNSPEC) THEN
        CALL INTLOG(JP_ERROR,
     X    'WV2DXXX: Number of wave spectra at each grid pt = ',NSPEC)
        CALL INTLOG(JP_ERROR,
     X    'WV2DXXX: And is greater than allowed maximum = ',JPNSPEC)
        WV2DXXX = JPROUTINE + 1
        GOTO 900
      ENDIF
C
C     Calculate number of latitudes if grid had been full from
C     North pole to South pole
C
      NUMLATS = (180000/ISEC2(10)) + 1
      IF( NUMLATS.GT.JPMXLAT ) THEN
        CALL INTLOG(JP_ERROR,
     X    'WV2DXXX: Number of latitudes in input grid = ',NUMLATS)
        CALL INTLOG(JP_ERROR,
     X    'WV2DXXX: And is greater than allowed maximum = ',JPMXLAT)
        WV2DXXX = JPROUTINE + 2
        GOTO 900
      ENDIF
      RLATINC = FLOAT(ISEC2(10))/1000
      DO LOOP = 1, NUMLATS
        OLDLATS(LOOP) = 90.0 - (LOOP-1)*RLATINC
      ENDDO
C
C     Fill an array with the number of points at each latitude for the
C     input field (this is a reduced latitude/longitude grid)
C
      MISSLAT = (90000 - ISEC2(4))/ISEC2(10)
      DO LOOP = 1, MISSLAT
        NPTS(LOOP)    = 0
      ENDDO
      KOLDNUM = 1 + (90000 - ISEC2(7))/ISEC2(10)
      DO LOOP = 1, (KOLDNUM-MISSLAT)
        IF( NIREPR.EQ.JPREDLL ) THEN
          NPTS(LOOP+MISSLAT) = ISEC2(22+LOOP)
        ELSE
          NPTS(LOOP+MISSLAT) = ISEC2(2)
        ENDIF
      ENDDO
      DO LOOP = (KOLDNUM+1), NUMLATS
        NPTS(LOOP)    = 0
      ENDDO
C
C ---------------------------------------------------------------------
C*    Section 2. Setup number of points at each latitude for the
C                output latitude/longitude field.
C ---------------------------------------------------------------------
C
  200 CONTINUE
C
      IF( (NOREPR.EQ.JPQUASI) .OR. (NOREPR.EQ.JPGAUSSIAN) ) THEN
C
C       Reduced (quasi-regular) gaussian output
C
        KNEWNUM = NOGAUSS*2
        DO LOOP = 1, KNEWNUM
          NUMNEW(LOOP)  = NOLPTS(LOOP)
          NEWLATS(LOOP) = ROGAUSS(LOOP)
        ENDDO
C
      ELSE IF( NOREPR.EQ.JPREDLL ) THEN
C
C       Reduced (quasi-regular) lat/long output
C
        KNEWNUM = NOREDLL
        DO LOOP = 1, KNEWNUM
          NUMNEW(LOOP)  = NOLPTS(LOOP)
          NEWLATS(LOOP) = ROREDLL(LOOP)
        ENDDO
C
      ELSE
C
C       Regular output
C
        MISSLAT = NINT((90.0 - NORTH)/STEPNS)
        DO LOOP = 1, MISSLAT
          NUMNEW(LOOP)    = 0
        ENDDO
        DO LOOP = 1, NLATS
          NUMNEW(LOOP+MISSLAT) = NINT(360.0/STEPWE)
        ENDDO
C
        KNEWNUM = MISSLAT + NLATS
        DO LOOP = 1, KNEWNUM
          NEWLATS(LOOP) = 90.0 - (LOOP-1)*STEPNS
        ENDDO
C
      ENDIF
C
C ---------------------------------------------------------------------
C*    Section 3. Get the input GRIB field characteristics.
C ---------------------------------------------------------------------
C
  300 CONTINUE
C
C     Calculate the indices of the input grid points to be used for
C     the output points
C
      OLDWEST = FLOAT(ISEC2(5))/1000
      OLDEAST = FLOAT(ISEC2(8))/1000
      WV2DXXX = WV2DIDX(NUMLATS,NPTS,OLDLATS,OLDWEST,OLDEAST,
     X                  KNEWNUM, NUMNEW, NEWLATS, NEWIDX)
      IF( WV2DXXX.NE.0 ) THEN
        CALL INTLOG(JP_ERROR,
     X    'WV2DXXX: Unable to calculate output grid indices',JPQUIET)
        WV2DXXX = JPROUTINE + 3
        GOTO 900
      ENDIF
C
C     Find section offsets for the GRIB product
C
      IRET = SOFFSET(OLDWAVE, IS0, IS1, IS2, IS3, IS4, IEDITN)
      IF( IRET.NE.0 ) THEN
        CALL INTLOG(JP_ERROR,
     X    'WV2DXXX: Problem finding section offsets for GRIB',JPQUIET)
        WV2DXXX = JPROUTINE + 4
        GOTO 900
      ENDIF
C
C     Get the overall length of OLDWAVE
C
#ifdef INTEGER_8
      NBIT = 64
#else
      NBIT = 32
#endif
      INSPT = (IS0 + 4) * 8
      CALL INXBIT(OLDWAVE,10,INSPT,NLENG,1,NBIT,24,'D',NRETA)
      IF( NRETA.NE.0 ) THEN
        CALL INTLOG(JP_ERROR,
     X    'WV2DXXX: Problem extracting overall length of GRIB',JPQUIET)
        WV2DXXX = JPROUTINE + 5
        GOTO 900
      ENDIF
C
C     Get the scale factor
C
      INSPT = (IS4 + 4) * 8
      CALL INXBIT(OLDWAVE,NLENG,INSPT,NSCALE,1,NBIT,16,'D',NRETA)
      IF( NRETA.NE.0 ) THEN
        CALL INTLOG(JP_ERROR,
     X    'WV2DXXX: Problem extracting scale factor in GRIB',JPQUIET)
        WV2DXXX = JPROUTINE + 6
        GOTO 900
      ENDIF
      CALL DSGNBT(ISCALE,NSCALE,16,NRETA)
      IF( NRETA.NE.0 ) THEN
        CALL INTLOG(JP_ERROR,
     X    'WV2DXXX: Problem setting sign of scale factor',JPQUIET)
        WV2DXXX = JPROUTINE + 7
        GOTO 900
      ENDIF
      SCALE = 2.0**(FLOAT(ISCALE))
C
C     Get the reference value
C
      CALL INXBIT(OLDWAVE,NLENG,INSPT,NEXP,1,NBIT,8,'D',NRETA)
      CALL INXBIT(OLDWAVE,NLENG,INSPT,NMANT,1,NBIT,24,'D',NRETB)
      IF( (NRETA.NE.0) .OR. (NRETB.NE.0) ) THEN
        CALL INTLOG(JP_ERROR,
     X    'WV2DXXX: Problem getting reference value from GRIB',JPQUIET)
        WV2DXXX = JPROUTINE + 8
        GOTO 900
      ENDIF
      CALL DECFP2(REFVAL,NEXP,NMANT)
C
C     Get number of bits per packed value
C
      CALL INXBIT(OLDWAVE,NLENG,INSPT,IBITS,1,NBIT,8,'D',NRETA)
      IF( NRETA.NE.0 ) THEN
        CALL INTLOG(JP_ERROR,
     X    'WV2DXXX: Problem getting number of bits per word',JPQUIET)
        WV2DXXX = JPROUTINE + 9
        GOTO 900
      ENDIF
C
C     (Pointer INSPT is currently at octet 12 in GRIB section 4)
C
C     Set up pointers to start of secondary bitmap and start of packed
C     data values
C
#ifdef INTEGER_8
      NBIT = 64
#else
      NBIT = 32
#endif
      NPBTMP2 = (IS4 + 24)*8 + (ISEC4(53)+ISEC4(55))*32
C
      IF( .NOT. LSIMPLE ) THEN
        NPDATA  = NPBTMP2 + NSPEC*ONEBITS(OLDWAVE,IS3)
      ELSE
        NPDATA  = NPBTMP2
      ENDIF
      NPDATA  = ((NPDATA + 7)/8)*8
C
C ---------------------------------------------------------------------
C*    Section 4. Work through the output subarea.
C ---------------------------------------------------------------------
C
  400 CONTINUE
C
C     Fill in the wave spectra values
C
      NEXT = 0
      NEXTWV = 0
C
      SOUTH = NOAREA(3)/PPMULT
      EAST  = NOAREA(4)/PPMULT
      ISTART = 0
C
C     Work down through latitudes from north to south.
C
      DO NROW = 1, KNEWNUM
C
C       If inside north-south (subarea) boundaries ..
C
        IF( (NOREPR.EQ.JPGAUSSIAN).OR.(NOREPR.EQ.JPQUASI) ) THEN
          PTLAT = ROGAUSS(NROW)
        ELSE
          PTLAT = 90.0 - (NROW-1)*STEPNS
        ENDIF
C
        IF( (PTLAT.LE.NORTH).AND.(ABS(PTLAT-SOUTH).GT.-0.0005) ) THEN
C
C         Calculate number of points between west boundary of area and
C         Greenwich
C
          ROWINC = 360.0/NUMNEW(NROW)
C
          IWEST = INT(WEST/ROWINC)
          IF( (WEST.GT.0.0).AND.(WEST.NE.(IWEST*ROWINC)) )
     X      IWEST = IWEST + 1
          AWEST = IWEST * ROWINC
          IWOFSET = NUMPTWE(AWEST,0.0,ROWINC)
          IEOFSET = NUMPTWE(AWEST,EAST,ROWINC)
C
C         Work through subarea longitudes from west to east.
C
          DO NCOL = 1, NUMNEW(NROW)
            PTLONG = AWEST + (NCOL-1)*ROWINC
            NEXT = NUMPTWE(AWEST,PTLONG,ROWINC)
            IF( (NEXT.LE.IEOFSET).AND.(NEXT.GE.0) ) THEN
C
C             .. and inside west-east (subarea) boundaries
C
              NEXT = 1 + NEXT - IWOFSET
              IF( NEXT.LE.0) NEXT = NEXT + NUMNEW(NROW)
              NEXT = NEXT + ISTART
              INDEX = NEWIDX(NEXT)
              ILOCATE = VALPINA(OLDWAVE, IS3+6, INDEX)
C
              IF( ILOCATE.EQ.0 ) THEN
C
C               Nearest neighbour is a 'missing' point
C
                DO LOOP = 1, NSPEC
                  NEXTWV = NEXTWV + 1
                  NEWWAVE(NEXTWV) = PMISS
                ENDDO
C
              ELSE
C
C               Nearest neighbour has values
C
                IF( LSIMPLE ) THEN
                  INSPT = NPDATA + (ILOCATE - 1)*IBITS
                  NVALS = 1
                  IBITMAP(1) = 1
                ELSE
C
C                 Count the number of values in the secondary bitmap upto
C                 the current point and pick up its secondary bitmap.
C
                  INSPT = NPBTMP2 + (ILOCATE - 1)*NSPEC
                  NVALS = NUMVALS(OLDWAVE,NPBTMP2,INSPT)
                  CALL INXBIT(OLDWAVE,NLENG,INSPT,IBITMAP,NSPEC,
     X                        NBIT,1,'D',NRETA)
                  IF( NRETA.NE.0 ) THEN
                    CALL INTLOG(JP_ERROR,
     X              'WV2DXXX: Problem getting neighbours 2ndary bitmap',
     X              JPQUIET)
                    WV2DXXX = JPROUTINE + 10
                    GOTO 900
                  ENDIF
C
C                 Pick up the values at the current point
C
                  INSPT = NPDATA + NVALS*IBITS
                ENDIF
C
                DO LOOP = 1, NSPEC
                  NEXTWV = NEXTWV + 1
                  IF( IBITMAP(LOOP).EQ.0 ) THEN
C
C                   ..missing
C
                    NEWWAVE(NEXTWV) = PMISS
C
                  ELSE
C
C                   ..retrieve and recreate the packed value
C
                    CALL INXBIT(OLDWAVE,NLENG,INSPT,ITEMP,1,
     X                          NBIT,IBITS,'D',NRETA)
                    IF( NRETA.NE.0 ) THEN
                      CALL INTLOG(JP_ERROR,
     X                'WV2DXXX: Problem getting nearest neighbour',
     X                JPQUIET)
                      WV2DXXX = JPROUTINE + 11
                      GOTO 900
                    ENDIF
                    NEWWAVE(NEXTWV) = REFVAL + FLOAT(ITEMP)*SCALE
                  ENDIF
                ENDDO
C
              ENDIF
            ENDIF
          ENDDO
C
        ENDIF
        ISTART = ISTART + NUMNEW(NROW)
      ENDDO
C
C ---------------------------------------------------------------------
C*    Section 9. Closedown.
C ---------------------------------------------------------------------
C
  900 CONTINUE
      RETURN
      END
