Page History

C
C Copyright 2015 ECMWF.
C
C This software  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
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 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 IVOGRIBJPBYTES  ! 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, command line.
CIRET, N
      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'
        STOP
      END IF

INTUVP2, IARGC


C     ------------------------------------------------------------------


C     Pick up file names from command line
      INFILE  = ' '
      OUTFILE DO= 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
            CALL INFILE=CARGGETARG(JN+1,INFILE)
          ELSEIF (CARG(J)ARG.EQ.'-o') THEN
           OUTFILE=CARG(J CALL GETARG(N+1,OUTFILE)
          ENDIF
        ENDDO
      ENDIF
     ELSE CALL CHECK(
     _   print*,'INDEX(INFILE,' ').EQ.1 .OR. INDEX(OUTFILE,' ').EQ.1,
     _  'Usage: interpolationexample_example2intuvp2 -i infile -o outfile' )

      INTV  STOP= 0
      REALV  END IF
 102  CONTINUE

C **********************************************************************= 0.
      CHARV = ''


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)
      IF ( IERR .NE. 0 ) STOP ' PBOPEN failed'
CCALL CHECK(IRET.NE.0, 'PBOPEN failed (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
      IF ( IERR ENDIF
      CALL CHECK(IRET.NE. 0, ) STOP ' PBGRIB failed for divergence'
C(d)')

C     CreateInterpolate
 U and V
     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 products u/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 *, 'Interpolated CALL', PBCLOSE(IUNIT2N-1), IERR)
C' vo/d pair(s).'
      END


C     ------------------------------------------------------------------


      SUBROUTINE CHECK(OOPS,MSG)
      STOPIMPLICIT NONE
      LOGICAL OOPS
      CHARACTER MSG*(*)
      IF (OOPS) THEN
        PRINT *, MSG
        CALL EXIT(3)
      ENDIF
      END