The following Fortran program opens a file and reads vorticity and divergence spectral fields in GRIB format; it then calls INTUVP2 to create spectral U and V fields. Because of the preliminary call to INTOUT, the U and V fields are subsequently interpolated to grid-point fields with resolution 3deg by 3deg without the need for a separate call to INTF. The function INTIN is not used here because the input fields are in GRIB format and are self-defining.
Subroutines PBOPEN, PBCLOSE, PBGRIB and PBWRITE handle pure binary input and output files.
| Code Block |
|---|
PROGRAM SAMPLE4
C
IMPLICIT NONE
INTEGER INTV
REAL REALV
CHARACTER*20 CHARV
DIMENSION INTV(4), REALV(4), CHARV(4)
C
INTEGER JPGRIB, JPBYTES
C
PARAMETER (JPGRIB = 7000000)
C
C Set JPBYTES = 8 on a 64-bit machine.
PARAMETER (JPBYTES = 4)
C
INTEGER IVOGRIB (JPGRIB), IDVGRIB (JPGRIB)
INTEGER IUGRIB (JPGRIB), IVGRIB (JPGRIB)
C
INTEGER IUNIT1, IUNIT2, IREC, INLENG, IERR, IRET,J,NARGS
C
C Externals
INTEGER INTOUT, INTUVP2, IARGC
LOGICAL ISSAME
C
CHARACTER*128 INFILE, OUTFILE, CARG(4)
C **********************************************************************
C
C Pick up file names from command line.
C
NARGS = IARGC()
IF( NARGS.LT.4 ) THEN
print*,'Usage: interpolation_example2 -i infile -o outfile'
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_example2 -i infile -o outfile'
STOP
END IF
102 CONTINUE
C **********************************************************************
C Set output grid interval
REALV(1) = 3.0
REALV(2) = 3.0
IRET = INTOUT('grid',INTV,REALV,CHARV)
IF ( IRET .NE. 0 ) THEN
STOP 'grid setting INTOUT failed.'
ENDIF
C
C Open input and output files.
CALL PBOPEN(IUNIT1, INFILE, 'r', IERR)
IF ( IERR .NE. 0 ) STOP ' PBOPEN failed'
CALL PBOPEN(IUNIT2, OUTFILE, 'w', IERR)
IF ( IERR .NE. 0 ) STOP ' PBOPEN failed'
C
C Read vorticity.
CALL PBGRIB(IUNIT1, IVOGRIB, JPGRIB * JPBYTES, IREC, IERR)
IF ( IERR .EQ. -1 ) GOTO 900
IF ( IERR .NE. 0 ) STOP ' PBGRIB failed for vorticity'
C
C Read divergence.
CALL PBGRIB(IUNIT1, IDVGRIB, JPGRIB * JPBYTES, IREC, IERR)
IF ( IERR .EQ. -1 ) GOTO 900
IF ( IERR .NE. 0 ) STOP ' PBGRIB failed for divergence'
C
C Create U and V
WRITE(*,*) ' Create U and V.'
INLENG = JPGRIB
IRET = INTUVP2(IVOGRIB, IDVGRIB, JPGRIB, IUGRIB, IVGRIB, INLENG)
IF ( IRET .NE. 0 ) THEN
WRITE(*,*) ' INTUVP failed.'
STOP
ENDIF
C
C Write the new U and V products to file
IF ( INLENG .GT. 0 ) THEN
CALL PBWRITE(IUNIT2, IUGRIB, INLENG*JPBYTES, IERR)
IF ( IERR .LT. (INLENG*JPBYTES) ) STOP ' PBWRITE failed'
CALL PBWRITE(IUNIT2, IVGRIB, INLENG*JPBYTES, IERR)
IF ( IERR .LT. (INLENG*JPBYTES) ) STOP ' PBWRITE failed'
ENDIF
C
C Closedown
900 CONTINUE
C
C Close input and output files.
CALL PBCLOSE(IUNIT1, IERR)
CALL PBCLOSE(IUNIT2, IERR)
C
STOP
END |