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

       PROGRAM SAMPLE1
C
      IMPLICIT NONE
      INTEGER IPROD
      INTEGER INTV
      REAL REALV
      CHARACTER*20 CHARV
      DIMENSION INTV(4), REALV(4), CHARV(4)
C
      INTEGER JPGRIB, JPBYTES
C
      PARAMETER (JPGRIB = 2000000)
C
C     JPBYTES is the size in bytes on an 'INTEGER'
C     Set JPBYTES = 8 on a 64-bit machine.
C
      PARAMETER (JPBYTES = 4)
C
      INTEGER INGRIB, NEWFLD
      DIMENSION INGRIB(JPGRIB), NEWFLD(JPGRIB)
C
      REAL ZNFELDI, ZNFELDO
      DIMENSION ZNFELDI(1), ZNFELDO(1)
C
      INTEGER IUNIT1, IUNIT2, IREC, INLEN, NEWLEN, IRET, NARGS
      INTEGER*4 J
C
C     Externals
      INTEGER INTOUT, INTF2, IARGC

      CHARACTER*128 INFILE, OUTFILE, CARG(4)
C
C **********************************************************************
C
C     Pick up file names from command line.
C
      NARGS = IARGC()
      IF( NARGS.LT.4 ) THEN
        print*,'Usage: interpolation_example -i inputfile -o outputfile'
        CALL EXIT(2)
      END IF

      DO 101 J=1,NARGS
      CALL GETARG(J,CARG(J))
 101  CONTINUE

      DO 102 J=1,NARGS,2
        IF(CARG(J).EQ.'-i') THEN
           INFILE=CARG(J+1)
        ELSEIF(CARG(J).EQ.'-o') THEN
           OUTFILE=CARG(J+1)
        ELSE
        print*,'Usage: interpolation_example -i inputfile -o outputfile'
        CALL EXIT(2)
        END IF
 102  CONTINUE

C     Define the packing accuracy for the new field(s).
C
      INTV(1) = 24
      IRET = INTOUT('accuracy', INTV, REALV, CHARV)
      IF ( IRET.NE.0 ) THEN
        WRITE(*,*) ' First INTOUT failed.'
        CALL EXIT(2)
      ENDIF
C
C     Define the geographical area for the new field(s).
C
      REALV(1) =  60.0
      REALV(2) = -10.0
      REALV(3) =  40.0
      REALV(4) =  15.0
      IRET = INTOUT('area', INTV, REALV, CHARV)
      IF ( IRET.NE.0 ) THEN
        WRITE(*,*) ' Second INTOUT failed.'
        CALL EXIT(2)
      ENDIF
C
C     Define the grid interval for the new field(s).
C
      REALV(1) = 1.5
      REALV(2) = 1.5
      IRET = INTOUT('grid', INTV, REALV, CHARV)
      IF ( IRET.NE.0 ) THEN
        WRITE(*,*) ' Third INTOUT failed.'
        CALL EXIT(2)
      ENDIF
C
C     Open input and output files.
C
      CALL PBOPEN(IUNIT1, INFILE, 'r', IRET)
      IF ( IRET.NE.0 ) THEN
        WRITE(*,*) ' PBOPEN failed'
        CALL EXIT(2)
      END IF
      CALL PBOPEN(IUNIT2, OUTFILE, 'w', IRET)
      IF ( IRET.NE.0 ) THEN
        WRITE(*,*) ' PBOPEN failed'
        CALL EXIT(2)
      END IF
      IPROD = 0
C
C     Start of loop through input GRIB-coded fields
C
 200  CONTINUE
        IPROD = IPROD + 1
C
C       Read next product.
C
        CALL PBGRIB(IUNIT1, INGRIB, JPGRIB*JPBYTES, IREC, IRET)
        IF ( IRET.EQ.-1 ) GOTO 900
        IF ( IRET.NE.0 ) THEN
            WRITE(*,*) ' PBGRIB failed'
            CALL EXIT(2)
         END IF
C
C       Interpolate.
C
        WRITE(*,*) ' Interpolate product number ', IPROD
        NEWLEN = JPGRIB
        INLEN  = IREC
        IRET = INTF2(INGRIB,INLEN,NEWFLD,NEWLEN)
        IF ( IRET.NE.0 ) THEN
          WRITE(*,*) ' INTF2 failed.'
          CALL EXIT(2)
        ENDIF
C
C       Write the new product to file.
C
       CALL PBWRITE( IUNIT2, NEWFLD, NEWLEN*JPBYTES, IRET)
        IF ( IRET.LT.(NEWLEN*JPBYTES) ) THEN
            WRITE(*,*) ' PBWRITE failed'
            CALL EXIT(2)
        END IF
C
C       Loop back for next product.
C
      GOTO 200
C
C     Closedown.
C
 900  CONTINUE
C
      IPROD = IPROD - 1
      WRITE(*,*) ' All done after ', IPROD, ' products.'
C
C     Close input and output files.
C 
      CALL PBCLOSE(IUNIT1, IRET)
      CALL PBCLOSE(IUNIT2, IRET)
C
      STOP
      END
