The following Fortran 77 program opens a file and reads vorticity and divergence (vo/d) 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 3 by 3deg 3 degrees 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 | ||||
---|---|---|---|---|
| ||||
C C Copyright 2015 ECMWF. C C This software is licensed under PROGRAM SAMPLE4the terms of the Apache Licence C Version 2.0 which can be obtained 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) Cat http://www.apache.org/licenses/LICENSE-2.0. C C Unless required by applicable law or agreed to in writing, software C distributed under the License is distributed on an "AS IS" BASIS, C WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 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 EXAMPLE_INTUVP2 IMPLICIT NONE C Parameters INTEGER JPGRIB ! GRIB size (up to 1/16 deg) INTEGER IVOGRIB JPBYTES ! bytes/integer PARAMETER (JPGRIB), IDVGRIB= (JPGRIB33190420) #ifdef INTEGER_8 INTEGER IUGRIBPARAMETER (JPGRIB), IVGRIB (JPGRIB) CJPBYTES = 8) #else PARAMETER (JPBYTES = 4) #endif C Local variables INTEGER IUNIT1, IUNIT2, IREC, INLENG, IERR, IRET,J,NARGS C C INTV(4) Externals REAL INTEGER INTOUT, INTUVP2, IARGC REALV(4) LOGICALCHARACTER*20 ISSAMECHARV C CHARACTER*128 INFILE, OUTFILE, CARG(4) C ********************************************************************** C CARG PickINTEGER upINLEN, fileOUTLEN, namesU1, fromU2, commandIRET, line.N C NARGS = IARGC(INTEGER IVOGRIB(JPGRIB), IDVGRIB(JPGRIB) IF( NARGS.LT.4 ) THENINTEGER IUGRIB(JPGRIB), IVGRIB(JPGRIB) C Externals INTEGER INTOUT, print*,'Usage: interpolation_example2 -i infile -o outfile' STOPINTUVP2, IARGC C ------------------------------------------------------------------ C Pick up file names from command line END IF INFILE = ' ' DOOUTFILE = 101 J=1,NARGS' ' CALLIF( GETARGIARGC(J,CARG(J))).EQ.4 ) THEN 101 CONTINUE DO 102N J= 1,NARGS 4, 2 CALL GETARG(N,ARG) IF (CARG(J)ARG.EQ.'-i') THEN INFILE=CARG(J CALL GETARG(N+1,INFILE) ELSEIF (CARG(J)ARG.EQ.'-o') THEN OUTFILE=CARG(J CALL GETARG(N+1,OUTFILE) ENDIF ENDDO ENDIF CALL ELSECHECK( _ print*,'INDEX(INFILE,' ').EQ.1 .OR. INDEX(OUTFILE,' ').EQ.1, _ 'Usage: interpolationexample_example2intuvp2 -i infile -o outfile' ) INTV = STOP0 REALV = 0. END IF 102CHARV = CONTINUE C **********************************************************************'' C SetDefine outputthe grid interval for the output REALV(1) = 3.0 REALV(2) = 3.0 IRET = INTOUT('grid', INTV, REALV, CHARV) IFCALL CHECK( IRET .NE.0, 0'INTOUT (grid) THENfailed') REALV STOP 'grid setting INTOUT failed.' ENDIF C= 0. C Open input and output files. CALL PBOPEN(IUNIT1U1, INFILE, 'r', IERRIRET) IFCALL CHECK( IERR IRET.NE. 0, ) STOP ' PBOPEN failed (r)') CALL PBOPEN(IUNIT2U2, OUTFILE, 'w', IERRIRET) CALL CHECK(IRET.NE.0, 'PBOPEN IF ( IERR .NE. 0 ) STOP ' PBOPEN failed' Cfailed (w)') C Start of loop on input vo/d pairs PRINT *, 'Start interpolation...' N = 0 220 CONTINUE N = N + 1 C Read vorticity. next vo/d pair CALL PBGRIB(IUNIT1U1, IVOGRIB, JPGRIB * JPBYTES, IRECINLEN, IERRIRET) IF ( IERR IRET.EQ. -1 ) GOTO 900THEN IF ( IERRIRET .NE.= 0 ) STOP ' PBGRIB failed forGOTO vorticity' C C290 ENDIF Read divergence.CALL CHECK(IRET.NE.0, 'PBGRIB failed (vo)') CALL PBGRIB(IUNIT1U1, IDVGRIB, JPGRIB * JPBYTES, IRECINLEN, IERRIRET) IF ( IERR IRET.EQ. -1 )) THEN IRET = 0 GOTO 900290 ENDIF IF ( IERRCALL CHECK(IRET.NE. 0 ), STOP ' PBGRIB failed for divergence' C(d)') C Create U and V Interpolate PRINT WRITE(*,*) 'Interpolate Createvo/d Upair and V.'#', N INLENGOUTLEN = JPGRIB IRET = INTUVP2(IVOGRIB, IDVGRIB, JPGRIB, IUGRIB, IVGRIB, INLENGOUTLEN) IFCALL CHECK( IRET .NE. 0 ) THEN WRITE(*,*) ' INTUVP failed.' STOP ENDIF C') C Write the new U and V productsu/v to file IF ( INLENG OUTLEN.GT. 0 ) THEN CALL PBWRITE(IUNIT2U2, IUGRIB, INLENG*JPBYTESOUTLEN, IERRIRET) IFCALL CHECK( IERR IRET.LT. (INLENG*JPBYTES) ) STOP ' OUTLEN,'PBWRITE failed (vo)') CALL PBWRITE(IUNIT2U2, IVGRIB, INLENG*JPBYTESOUTLEN, IERRIRET) IFCALL CHECK( IERR IRET.LT. (INLENG*JPBYTES) ) STOP ' OUTLEN,'PBWRITE failed (d)') ENDIF C C Closedown 900 CONTINUE CLoop back for next vo/d pair GOTO 220 C Close input and output files. 290 CONTINUE CALL PBCLOSE(U1, IRET) CALL PBCLOSE(IUNIT1U2, IERRIRET) PRINT CALL PBCLOSE(IUNIT2, IERR) C *, 'Interpolated ', (N-1), ' vo/d pair(s).' END C ------------------------------------------------------------------ SUBROUTINE CHECK(OOPS,MSG) IMPLICIT NONE LOGICAL OOPS STOPCHARACTER MSG*(*) IF (OOPS) THEN PRINT *, MSG CALL EXIT(3) ENDIF END |