Page History

      PROGRAM SAMPLE2
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'
        STOP
      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'
        STOP
        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.'
        STOP
      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.'
        STOP
      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.'
        STOP
      ENDIF
C
C     Open input and output files.
C
      CALL PBOPEN(IUNIT1, INFILE, 'r', IRET)
      IF ( IRET.NE.0 ) STOP ' PBOPEN failed'
      CALL PBOPEN(IUNIT2, OUTFILE, 'w', IRET)
      IF ( IRET.NE.0 ) STOP ' PBOPEN failed'
      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 ) STOP ' PBGRIB failed'
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(*,*) ' INTF failed.'
          STOP
        ENDIF
C
C       Write the new product to file.
C
       CALL PBWRITE( IUNIT2, NEWFLD, NEWLEN*JPBYTES, IRET)
        IF ( IRET.LT.(NEWLEN*JPBYTES) ) STOP ' PBWRITE failed'
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