core
/
eccodes
mirror of https://github.com/ecmwf/eccodes.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Removed obsolete F77 examples (no more support for Fortran 77)

This commit is contained in:
Shahram Najm 2016-02-16 16:09:16 +00:00
parent 72d6674fe2
commit c47980458b
24 changed files with 0 additions and 1697 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
examples/F77/Makefile.am
View File

@ -1,26 +0,0 @@
AM_CFLAGS = @WARN_PEDANTIC@ @WERROR@ @FORCE_32_CFLAGS@
TESTS = iterator_fortran.sh get_fortran.sh print_data_fortran.sh set_fortran.sh keys_iterator_fortran.sh \
multi_fortran.sh precision_fortran.sh
noinst_PROGRAMS = iterator_fortran get_fortran print_data_fortran set_fortran set_missing_fortran keys_iterator_fortran \
multi_fortran precision_fortran set_pv_fortran
get_fortran_SOURCES = get_fortran.F
print_data_fortran_SOURCES = print_data_fortran.F
set_fortran_SOURCES = set_fortran.F
set_missing_fortran_SOURCES = set_missing_fortran.F
iterator_fortran_SOURCES = iterator_fortran.F
keys_iterator_fortran_SOURCES = keys_iterator_fortran.F
multi_fortran_SOURCES = multi_fortran.F
precision_fortran_SOURCES = precision_fortran.F
set_pv_fortran_SOURCES = set_pv_fortran.F
INCLUDES = -I$(top_builddir)/src -I$(top_builddir)/fortran
LDADD = $(top_builddir)/fortran/libgrib_api_f77.a $(top_builddir)/src/libgrib_api.a
DEPENDENCIES = $(LDADD)
EXTRA_DIST =$(TESTS) include.sh

91
examples/F77/example.F
View File

@ -1,91 +0,0 @@
C Copyright 2005-2016 ECMWF.
C
C This software is licensed under the terms of the Apache Licence Version 2.0
C 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 granted to it by
C virtue of its status as an intergovernmental organisation nor does it submit to any jurisdiction.
C
C
C
C Fortran 77 Implementation: keys_iterator
C
C Description:
C Example on how to use keys_iterator functions and the
C grib_keys_iterator structure to get all the available
C keys in a message.
C
C
C
C
program keys_iterator
implicit none
include 'grib_api_f77.h'
integer ifile,igrib,iret
integer grib_count
integer maxNumberOfValues
parameter( maxNumberOfValues = 10000 )
include 'grib_api_fortran.h'
integer ifile
integer iret
integer igrib
integer i
real*8 values(maxNumberOfValues)
integer*4 numberOfValues
character*256 error
integer*4 size
size=maxNumberOfValues
ifile=5
iret=grib_open_file(ifile
X,'../x.grib1','r')
call grib_check(grib_open_file(outfile
X,'../out.grib1','w'))
C Loop on all the messages in a file.
10 iret=grib_new_from_file(ifile,igrib)
if (igrib .eq. -1 ) then
if (iret .ne.0) then
call grib_check(iret)
endif
stop
endif
grib_count=grib_count+1
write(*,*) '-- GRIB N. ',grib_count,' --'
C a new grib message is loaded from file
C igrib is the grib id to be used in subsequent calls
call grib_check( grib_new_from_file(ifile,igrib) )
C get the size of the values array
call grib_check(grib_get_size(igrib,'values',numberOfValues))
write(*,*) 'numberOfValues=',numberOfValues
C get data values
call grib_check(grib_get_real8_array(igrib,'values',values,size))
if ( size .ne. numberOfValues ) then
write(*,*) 'ERROR: wrong numberOfValues'
stop
endif
do i=1,numberOfValues
values(i)=values(i)*9.8;
enddo
call grib_check(grib_set_real8_array(igrib,'values',values,size))
C write modified message to a file
call grib_check(grib_write(igrib,outfile))
goto 10
call grib_check(grib_release(igrib))
call grib_check(grib_close_file(ifile))
end

74
examples/F77/files_fortran.F
View File

@ -1,74 +0,0 @@
C Copyright 2005-2016 ECMWF.
C
C This software is licensed under the terms of the Apache Licence Version 2.0
C 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 granted to it by
C virtue of its status as an intergovernmental organisation nor does it submit to any jurisdiction.
C
C
C Fortran 77 Implementation: get_fortran
C
C Description: how to get values using keys.
C
C
C
C
program get
implicit none
include 'grib_api_f77.h'
integer ifile
integer iret
integer igrib
integer i
integer*4 Nj
dimension ifile(10)
dimension igrib(10)
iret=grib_open_file(ifile(1),'x.grib1','r')
call grib_check(iret)
call grib_check( grib_new_from_file(ifile(1),igrib(1)) )
iret=grib_open_file(ifile(2),'x.grib1','r')
call grib_check(iret)
call grib_check( grib_new_from_file(ifile(2),igrib(2)) )
print*,"ifile(1)=",ifile(1)," ifile(2)=",ifile(2)
iret=grib_open_file(ifile(3),'x.grib1','r')
call grib_check(iret)
call grib_check( grib_new_from_file(ifile(3),igrib(3)) )
call grib_check( grib_new_from_file(ifile(3),igrib(3)) )
iret=grib_open_file(ifile(4),'x.grib1','r')
call grib_check(iret)
call grib_check( grib_new_from_file(ifile(4),igrib(4)) )
print*,"ifile(3)=",ifile(3)," ifile(4)=",ifile(4)
call grib_check(grib_get_int(igrib(1),'Nj',Nj) )
write(*,*) 'Nj=',Nj
call grib_check(grib_get_int(igrib(2),'Nj',Nj) )
write(*,*) 'Nj=',Nj
call grib_check(grib_get_int(igrib(2),'Nj',Nj) )
write(*,*) 'Nj=',Nj
call grib_check(grib_get_int(igrib(3),'Nj',Nj) )
write(*,*) 'Nj=',Nj
call grib_check(grib_release(igrib(4)))
call grib_check(grib_release(igrib(3)))
call grib_check(grib_release(igrib(2)))
call grib_check(grib_release(igrib(1)))
call grib_check(grib_close_file(ifile(1)))
call grib_check(grib_close_file(ifile(2)))
call grib_check(grib_close_file(ifile(3)))
call grib_check(grib_close_file(ifile(4)))
end

130
examples/F77/get_fortran.F
View File

@ -1,130 +0,0 @@
C Copyright 2005-2016 ECMWF.
C
C This software is licensed under the terms of the Apache Licence Version 2.0
C 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 granted to it by
C virtue of its status as an intergovernmental organisation nor does it submit to any jurisdiction.
C
C
C Fortran 77 Implementation: get_fortran
C
C Description: how to get values using keys.
C
C
C
C
program get
implicit none
integer maxNumberOfValues
parameter( maxNumberOfValues = 10000 )
include 'grib_api_f77.h'
integer ifile
integer iret
integer igrib
integer i
real*8 latitudeOfFirstPointInDegrees
real*8 longitudeOfFirstPointInDegrees
real*8 latitudeOfLastPointInDegrees
real*8 longitudeOfLastPointInDegrees
real*8 jDirectionIncrementInDegrees
real*8 iDirectionIncrementInDegrees
integer*4 numberOfPointsAlongAParallel
integer*4 numberOfPointsAlongAMeridian
real*8 values(maxNumberOfValues)
integer*4 numberOfValues
real*8 average
character*256 error
integer*4 size
size=maxNumberOfValues
ifile=5
iret=grib_open_file(ifile
X,'../../data/regular_latlon_surface.grib1','r')
call grib_check(iret)
C a new grib message is loaded from file
C igrib is the grib id to be used in subsequent calls
call grib_check( grib_new_from_file(ifile,igrib) )
C get as a integer
call grib_check(grib_get_int(igrib,'numberOfPointsAlongAParallel'
X,numberOfPointsAlongAParallel) )
write(*,*) 'numberOfPointsAlongAParallel='
X,numberOfPointsAlongAParallel
C get as a integer
call grib_check( grib_get_int(igrib,'numberOfPointsAlongAMeridian'
X,numberOfPointsAlongAMeridian) )
write(*,*) 'numberOfPointsAlongAMeridian='
X,numberOfPointsAlongAMeridian
C get as a real8
call grib_check( grib_get_real8(igrib
X,'latitudeOfFirstGridPointInDegrees'
X,latitudeOfFirstPointInDegrees) )
write(*,*) 'latitudeOfFirstGridPointInDegrees='
X,latitudeOfFirstPointInDegrees
C get as a real8
call grib_check( grib_get_real8(igrib
X,'longitudeOfFirstGridPointInDegrees'
X,longitudeOfFirstPointInDegrees) )
write(*,*) 'longitudeOfFirstGridPointInDegrees='
X,longitudeOfFirstPointInDegrees
C get as a real8
call grib_check( grib_get_real8(igrib
X,'latitudeOfLastGridPointInDegrees'
X,latitudeOfLastPointInDegrees) )
write(*,*) 'latitudeOfLastGridPointInDegrees='
X,latitudeOfLastPointInDegrees
C get as a real8
call grib_check( grib_get_real8(igrib
X,'longitudeOfLastGridPointInDegrees'
X,longitudeOfLastPointInDegrees) )
write(*,*) 'longitudeOfLastGridPointInDegrees='
X,longitudeOfLastPointInDegrees
C get as a real8
call grib_check( grib_get_real8(igrib
X,'jDirectionIncrementInDegrees'
X,jDirectionIncrementInDegrees) )
write(*,*) 'jDirectionIncrementInDegrees='
X,jDirectionIncrementInDegrees
C get as a real8
call grib_check( grib_get_real8(igrib
X,'iDirectionIncrementInDegrees'
X,iDirectionIncrementInDegrees) )
write(*,*) 'iDirectionIncrementInDegrees='
X,iDirectionIncrementInDegrees
C get the size of the values array
call grib_check(grib_get_size(igrib,'values',numberOfValues))
write(*,*) 'numberOfValues=',numberOfValues
C get data values
call grib_check(grib_get_real8_array(igrib,'values',values,size))
if ( size .ne. numberOfValues ) then
write(*,*) 'ERROR: wrong numberOfValues'
stop
endif
average = 0
do i=1,numberOfValues
average = average + values(i);
enddo
average =average / numberOfValues
write(*,*)'There are ',numberOfValues
X,' average is ',average
call grib_check(grib_release(igrib))
call grib_check(grib_close_file(ifile))
end

7
examples/F77/get_fortran.sh
View File

@ -1,7 +0,0 @@
#!/bin/sh
. ./include.sh
${examples_dir}get_fortran > /dev/null

423
examples/F77/grib_convert.F
View File

@ -1,423 +0,0 @@
!-------------------------
PROGRAM CONVERT
!
!--------------------------------
! DESCRIPTION
!
! GRIB1 to GRIB2 Conversion
!
! Author: Jean Nicolau, METEO-FRANCE
!
!--------------------------------
! DECLARATIONS
!-------------------------------
INTEGER :: IFILEIN,IFILEOUT,GBID1,GBID2
INTEGER :: IVAL,IC,ICS,IECH,IDAT,IHOUR,INOFIE,IPAR,ITOFFS,ITEMP
INTEGER :: NARGS,IRT,ILONG,J,JCOUNT
INTEGER :: IPSOPD,IECHLSM,IPTI,ISVOFFS
INTEGER :: NI,NJ,INBITS,ISFOFFS,ITOSFS,ISFOSFS,ISVOSFS,IPC,IPN
INTEGER :: ILOTR,ITOSP,ITOEF,ITOPD,IPEN
CHARACTER (LEN=4) :: CPARAM,CECH
CHARACTER (LEN=20) :: CFILEOUT
REAL :: RG=9.80665
REAL(KIND=8) , DIMENSION(:), ALLOCATABLE :: VALUES
REAL(KIND=8) :: XLAD = -9999.99
REAL(KIND=8) :: XLOD = -9999.99
REAL(KIND=8) :: XLAF = -9999.99
REAL(KIND=8) :: XLOF = -9999.99
REAL(KIND=8) :: XINCRI = -9999.99
REAL(KIND=8) :: XINCRJ = -9999.99
INCLUDE 'grib_api_fortran.h'
!
!***************************************************
! INITS
!****************************************************
!
READ(5,*) IPSOPD
IFILEIN = 15
IFILEOUT=16
GBID1 = 0
ILONG=0
IC=85
INOFIE=11
JCOUNT = 0
IECHLSM=0
!
!***************************************************
! OPEN FILES
!****************************************************
!
IRT = grib_open_file_ (IFILEIN,"INPUT","r")
IF ( IRT .LT. 0 ) THEN
WRITE (*,*) "PROBLEME ",IRT," POUR INPUT"
STOP ' erreur fichier '
ENDIF
IVAL=40
IRT = grib_open_file_ (IFILEOUT,'OUTPUT',"w")
JCOUNT = 0
50 CONTINUE
JCOUNT = JCOUNT + 1
WRITE(*,*) "JCOUNT=",JCOUNT
!
!***************************************************
! READ GRIB1
!****************************************************
!
IRT=1
IRT = grib_new_from_file_(IFILEIN,GBID1)
WRITE (*,*) "code reponse entete grib ",IRT
IF (IRT.NE. 0 )WRITE (*,*) "code reponse entete grib ",IRT
!
IF ( GBID1 .LT. 0 ) THEN
WRITE (*, *) 'total ', JCOUNT ,' ret = ', IRT
IRT = grib_close_file_(IFILEIN)
GOTO 60
ENDIF
!
! CENTRE
! ------
!
IRT = grib_get_int_(GBID1,
S"identificationOfOriginatingGeneratingSubCentre",ICS)
IRT = grib_get_int_(GBID1,"indicatorOfParameter",IPAR)
!
! DATE
! ----
!
IF ( IPAR /= 81 ) THEN
IRT = grib_get_int_(GBID1,"dataDate",IDAT)
IRT = grib_get_int_(GBID1,"dataTime",IHOUR)
IRT = grib_get_int_(GBID1,"periodOfTime",IECH)
IRT = grib_get_int_(GBID1,"periodOfTimeIntervals",IPTI)
IF ( IPTI .EQ. 0 ) IECHLSM=IECH
ELSE
ICS=100
IECH=IECHLSM
IPTI=0
ENDIF
!
! PARAMETER
! ---------
!
IRT = grib_get_int_(GBID1,"indicatorOfTypeOfLevel",ITOFFS)
IRT = grib_get_int_(GBID1,"lev",ISVOFFS)
!
!
! Section 3
! =========
!
!
IRT = grib_get_int_(GBID1,"Ni",NI)
IRT = grib_get_int_(GBID1,"Nj",NJ)
IRT = grib_get_real8_(GBID1,
S"latitudeOfFirstGridPointInDegrees",XLAD)
IRT=grib_get_real8_(GBID1,
S"longitudeOfFirstGridPointInDegrees",XLOD)
IRT=grib_get_real8_(GBID1,
S"latitudeOfLastGridPointInDegrees",XLAF)
IRT=grib_get_real8_(GBID1,
S"longitudeOfLastGridPointInDegrees",XLOF)
IRT=grib_get_real8_(GBID1,"iDirectionIncrementInDegrees",XINCRI)
IRT=grib_get_real8_(GBID1,"jDirectionIncrementInDegrees",XINCRJ)
!
! Section 4
! =========
!
ILONG = NI*NJ
IRT=grib_get_int_(GBID1,
S"numberOfBitsContainingEachPackedValue",INBITS)
IF(.NOT.ALLOCATED(VALUES)) ALLOCATE(VALUES(ILONG))
IRT=grib_get_real8_array_(GBID1,"values",VALUES,ILONG)
!
!************************************************************
!
! WRITE GRIB2
! --------------
!
!************************************************************
!
IRT= grib_new_from_samples_(GBID2,"GRIB2")
ISFOFFS=-9999
IRT=grib_set_int_(GBID2,"editionNumber",2)
IRT=grib_set_int_(GBID2,"dataRepresentationTemplateNumber",IVAL)
IRT = grib_set_int_(GBID2,
S"identificationOfOriginatingGeneratingCentre",IC)
IRT = grib_set_int_(GBID2,
S"identificationOfOriginatingGeneratingSubCentre",ICS)
IRT=grib_set_int_(GBID2,"productionStatusOfProcessedData",IPSOPD)
IRT = grib_set_int_(GBID2,"dataDate",IDAT)
IRT = grib_set_int_(GBID2,"dataTime",IHOUR)
IRT=grib_set_int_(GBID2,"shapeOfTheEarth",6)
IRT=grib_set_int_(GBID2,"dataRepresentationType",0)
IRT=grib_set_int_(GBID2,"numberOfPointsAlongAParallel",NI)
IRT=grib_set_int_(GBID2,"fieldWidth",NI)
IRT=grib_set_int_(GBID2,"numberOfPointsAlongAMeridian",NJ)
IRT=grib_set_int_(GBID2,"fieldHeight",NJ)
IRT=grib_set_real8_(GBID2,
S"latitudeOfFirstGridPointInDegrees",XLAD)
IF(XLOD.LT.0.0) XLOD= 360.00 + XLOD
IRT=grib_set_real8_(GBID2,
S"longitudeOfFirstGridPointInDegrees",XLOD)
IRT=grib_set_real8_(GBID2,
S"latitudeOfLastGridPointInDegrees",XLAF)
IF(XLOF.LT.0.0) XLOF= 360.00 + XLOF
IRT=grib_set_real8_(GBID2,
S"longitudeOfLastGridPointInDegrees",XLOF)
IRT=grib_set_real8_(GBID2,"iDirectionIncrementInDegrees",XINCRI)
IRT=grib_set_real8_(GBID2,"jDirectionIncrementInDegrees",XINCRJ)
!
!
! Section 4
! =========
!
ITEMP=1
ITOSFS=255
ISFOSFS=255
ISVOSFS=255
SELECT CASE (IPAR)
CASE (33)
IPC=2
IPN=2
SELECT CASE (ITOFFS)
CASE(105)
CPARAM="10u"
ITOFFS=103
ISFOFFS=0
CASE (100)
ISFOFFS=0
ISVOFFS=ISVOFFS*100
CPARAM="u"
CASE (117)
CPARAM="u"
ITOFFS=109
ISFOFFS=6
ISVOFFS=ISVOFFS/1000
END SELECT
CASE (34)
IPC=2
IPN=3
SELECT CASE (ITOFFS)
CASE(105)
CPARAM="10v"
ITOFFS=103
ISFOFFS=0
CASE (100)
ISFOFFS=0
ISVOFFS=ISVOFFS*100
CPARAM="v"
CASE (117)
CPARAM="v"
ITOFFS=109
ISFOFFS=6
ISVOFFS=ISVOFFS/1000
END SELECT
CASE (11)
IPC=0
IPN=0
SELECT CASE (ITOFFS)
CASE (111)
CPARAM="st"
IPN=2
ITOFFS=106
ISVOFFS=0
ITOSFS=106
ISFOFFS=0
ISFOSFS=1
ISVOSFS=2
IRT=grib_set_int_(GBID2,"discipline",2)
CASE(105)
CPARAM="2t"
IPN=0
ITOFFS=103
ISFOFFS=0
ISVOFFS=2
IRT=grib_set_int_(GBID2,"binaryScaleFactor",-4)
IRT=grib_set_int_(GBID2,"decimalScaleFactor",0)
CASE (100)
IPN=0
ISFOFFS=0
ISVOFFS=ISVOFFS*100
CPARAM="t"
CASE (1)
CPARAM="skt"
ITOSFS=255
IPN=17
END SELECT
CASE (114)
CPARAM="ttr"
ITOFFS=8
IPC=5
IPN=5
CASE (8)
CPARAM="orog"
IPC=3
IPN=5
CASE (17)
CPARAM="2d"
IPC=0
IPN=6
ITOFFS=103
ISFOFFS=0
ISVOFFS=2
IRT=grib_set_int_(GBID2,"binaryScaleFactor",-9)
IRT=grib_set_int_(GBID2,"decimalScaleFactor",-2)
CASE (51)
CPARAM="q"
IPC=1
IPN=0
ISFOFFS=0
ISVOFFS=ISVOFFS*100
IRT=grib_set_int_(GBID2,"binaryScaleFactor",-22)
IRT=grib_set_int_(GBID2,"decimalScaleFactor",-2)
CASE (6)
CPARAM="gh"
VALUES=VALUES/RG
ISFOFFS=0
ISVOFFS=ISVOFFS*100
IPC=3
IPN=5
CASE (13)
CPARAM="pt"
IPC=0
IPN=2
ITOFFS=109
ISFOFFS=6
ISVOFFS=ISVOFFS/1000
CASE (2)
CPARAM="msl"
IPC=3
IPN=0
ITOFFS=101
CASE (71)
CPARAM="tcc"
IPC=6
IPN=1
ITOSFS=8
IRT=grib_set_int_(GBID2,"binaryScaleFactor",-7)
IRT=grib_set_int_(GBID2,"decimalScaleFactor",-2)
CASE (65)
CPARAM="sd"
ITOSFS=255
IPC=1
IPN=60
CASE (61)
CPARAM="tp"
ITOSFS=255
IPC=1
IPN=52
CASE (99)
CPARAM="sf"
ITOSFS=255
IPC=1
IPN=53
CASE (1)
CPARAM="sp"
ITOSFS=255
IPC=3
IPN=0
CASE (160)
CPARAM="cape"
ITOSFS=8
IPC=7
IPN=6
CASE (122)
CPARAM="sshf"
ITOSFS=255
IPC=0
IPN=11
CASE (121)
CPARAM="slhf"
ITOSFS=255
IPC=0
IPN=10
CASE (112)
CPARAM="str"
ITOSFS=255
IPC=5
IPN=5
CASE (111)
CPARAM="ssr"
ITOSFS=255
IPC=4
IPN=9
CASE (167)
CPARAM="tcw"
ITOSFS=8
IPC=1
IPN=51
ITOSFS=8
CASE (81)
CPARAM="lsm"
IRT=grib_set_int_(GBID2,"discipline",2)
IPC=0
IPN=0
END SELECT
ILOTR=0
ITOSP=0
IF ( IPTI .GT. 0 ) THEN
ITOSP=1
ITEMP=11
ITOSP=1
ILOTR=IPTI
IRT = grib_set_int_(GBID2,"productDefinitionTemplateNumber",ITEMP)
IRT = grib_set_int_(GBID2,"marsStartStep",0)
IRT = grib_set_int_(GBID2,"marsEndStep",IPTI)
ELSE
ITEMP=1
IRT = grib_set_int_(GBID2,"productDefinitionTemplateNumber",ITEMP)
IRT = grib_set_int_(GBID2,"forecastTime",IECH)
IRT = grib_set_int_(GBID2,"marstStep",IECH)
ENDIF
IRT=grib_set_int_(GBID2,"typeOfStatisticalProcessing",ITOSP)
IRT = grib_set_int_(GBID2,"typeOfGeneratingProcess",4)
IRT=grib_set_int_(GBID2,"generatingProcessIdentifier",211)
IF ( ICS .EQ. 100 .OR. ICS .EQ. 0 ) THEN
ITOEF=1
ITOPD=3
IPEN=0
ELSE
ITOEF=3
ITOPD=4
IPEN=ICS-100
ENDIF
IRT=grib_set_int_(GBID2,"typeOfEnsembleForecast",ITOEF)
IRT=grib_set_int_(GBID2,"typeOfProcessedData",ITOPD)
IRT=grib_set_int_(GBID2,"perturbationNumber",IPEN)
IRT=grib_set_int_(GBID2,"numberOfForecastsInEnsemble",INOFIE)
IRT=grib_set_int_(GBID2,"parameterCategory",IPC)
IRT=grib_set_int_(GBID2,"parameterNumber",IPN)
IRT=grib_set_int_(GBID2,"typeOfFirstFixedSurface",ITOFFS)
IF ( ISFOFFS /= -9999 ) THEN
IRT=grib_set_int_(GBID2,"scaleFactorOfFirstFixedSurface",ISFOFFS)
IRT=grib_set_int_(GBID2,"scaledValueOfFirstFixedSurface",ISVOFFS)
ENDIF
IRT=grib_set_int_(GBID2,"typeOfSecondFixedSurface",ITOSFS)
IF ( ISFOSFS .NE. 255 ) IRT=grib_set_int_(GBID2,
S "scaleFactorOfSecondFixedSurface",ISFOSFS)
IF ( ISVOSFS .NE. 255 ) IRT=grib_set_int_(GBID2,
S "scaledValueOfSecondFixedSurface",ISVOSFS)
IRT=grib_set_int_(GBID2,
S"numberOfBitsContainingEachPackedValue",INBITS)
IRT=grib_set_real8_array_(GBID2,"values",VALUES,ILONG)
IRT = grib_write_(GBID2,IFILEOUT)
IRT = grib_release_(GBID1)
!
!
DEALLOCATE(VALUES)
!
GO TO 50
60 CONTINUE
!
IRT = grib_close_file_(IFILEOUT)
!
END

38
examples/F77/include.sh
View File

@ -1,38 +0,0 @@
set -ea
echo
echo "TEST: $0"
if [ -z "${data_dir}" ]
then
cd ../../
cpath=`pwd`
ECCODES_DEFINITION_PATH=$cpath/definitions
export ECCODES_DEFINITION_PATH
ECCODES_SAMPLES_PATH=$cpath/templates
export ECCODES_SAMPLES_PATH
tools_dir=$cpath/tools/
examples_dir=$cpath/examples/F77/
data_dir=$cpath/data
else
echo "Skipping test $0"
exit
fi
cd ${examples_dir}
if [ -z "${GRIB_API_INCLUDE}" ]
then
GRIB_API_INCLUDE=`pwd`/src
fi
if [ -z "${GRIB_API_LIB}" ]
then
GRIB_API_LIB=`pwd`/src
fi
# Download the data needed for tests
${data_dir}/download.sh "${data_dir}"
set -u

82
examples/F77/iterator_fortran.F
View File

@ -1,82 +0,0 @@
C Copyright 2005-2016 ECMWF.
C
C This software is licensed under the terms of the Apache Licence Version 2.0
C 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 granted to it by
C virtue of its status as an intergovernmental organisation nor does it submit to any jurisdiction.
C
C
C
C Fortran 77 Implementation: iterator_fortran
C
C Description: how to use an iterator on lat/lon/values.
C
C
C
C
C
program iterator
implicit none
include 'grib_api_f77.h'
integer ifile
integer iret,iter
real*8 lat,lon,value,missingValue
integer n,flags
character*256 filename
character*256 error
C Message identifier.
integer igrib
ifile=5
call grib_check(grib_open_file(ifile,
X'../../data/regular_latlon_surface.grib1','r'))
C Loop on all the messages in a file.
10 iret=grib_new_from_file(ifile,igrib)
if (igrib .eq. -1 ) then
if (iret .ne.0) then
call grib_check(iret)
endif
stop
endif
C get as a real8
call grib_check(grib_get_real8(igrib
X,'missingValue',missingValue))
write(*,*) 'missingValue=',missingValue
C A new iterator on lat/lon/values is created from the message igrib
flags = 0
call grib_check(grib_iterator_new(igrib,iter,flags))
n = 0
C Loop on all the lat/lon/values.
20 iret = grib_iterator_next(iter,lat,lon,value)
if ( iret .eq. 0 ) goto 30
C You can now print lat and lon,
if ( value .eq. missingValue ) then
C decide what to print if a missing value is found.
write(*,*) "- ",n," - lat=",lat," lon=",lon," value=missing"
else
C or print the value if is not missing.
write(*,*) " ",n," lat=",lat," lon=",lon," value=",value
endif
n=n+1
goto 20
30 continue
C At the end the iterator is deleted to free memory.
call grib_check(grib_iterator_delete(iter))
goto 10
call grib_check(grib_release(igrib))
call grib_check(grib_close_file(ifile))
end

7
examples/F77/iterator_fortran.sh
View File

@ -1,7 +0,0 @@
#!/bin/sh
. ./include.sh
${examples_dir}iterator_fortran > /dev/null

76
examples/F77/keys_iterator_fortran.F
View File

@ -1,76 +0,0 @@
C Copyright 2005-2016 ECMWF.
C
C This software is licensed under the terms of the Apache Licence Version 2.0
C 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 granted to it by
C virtue of its status as an intergovernmental organisation nor does it submit to any jurisdiction.
C
C Fortran 77 Implementation: keys_iterator
C
C Description:
C Example on how to use keys_iterator functions and the
C grib_keys_iterator structure to get all the available
C keys in a message.
C
C
C
C
program keys_iterator
implicit none
include 'grib_api_f77.h'
character*20 name_space
integer kiter,ifile,igrib,iret
character*256 key
character*256 value
character*512 all
integer len,strlen
integer grib_count
len=256
ifile=5
call grib_check(grib_open_file(ifile,
X'../../data/regular_latlon_surface.grib1','r'))
grib_count=0
C Loop on all the messages in a file.
10 iret=grib_new_from_file(ifile,igrib)
if (igrib .eq. -1 ) then
if (iret .ne.0) then
call grib_check(iret)
endif
stop
endif
grib_count=grib_count+1
write(*,'("-- GRIB N.",I4," --")') grib_count
C valid name_spaces are ls and mars
name_space='ls'
C name_space=' ' to get all the keys */
C name_space=' '
call grib_check(
Xgrib_keys_iterator_new(igrib,kiter,name_space))
C call grib_check(grib_keys_iterator_skip_read_only(kiter))
C call grib_check(grib_keys_iterator_skip_function(kiter))
C call grib_check(grib_keys_iterator_skip_not_coded(kiter))
20 if (grib_keys_iterator_next(kiter) .ne. 1) goto 10
call grib_check(grib_keys_iterator_get_name(kiter,key))
call grib_check(grib_get_string(igrib,key,value))
all='|' // trim(key)//'|' // ' = ' //'|' // trim(value) // '|'
write(*,*) trim(all)
goto 20
call grib_check(grib_keys_iterator_delete(kiter))
call grib_check(grib_release(igrib))
call grib_check(grib_close_file(ifile))
end

27
examples/F77/keys_iterator_fortran.sh
View File

@ -1,27 +0,0 @@
#!/bin/sh
. ./include.sh
cat > test.txt <<EOF
-- GRIB N. 1 --
|edition| = |1|
|centre| = |ecmf|
|param| = |167.128|
|levelType| = |sfc|
|lev| = |0|
|date| = |20080206|
|stepUnits| = |h|
|stepRange| = |0|
|dataType| = |an|
|shortName| = |2t|
|valuesCount| = |496|
|packingType| = |grid_simple|
|gridType| = |regular_ll|
EOF
${examples_dir}keys_iterator_fortran > test_fortran.txt
diff test_fortran.txt test.txt
#rm -f test_fortran.txt test.txt

80
examples/F77/missing_value.F
View File

@ -1,80 +0,0 @@
C Copyright 2005-2016 ECMWF.
C
C This software is licensed under the terms of the Apache Licence Version 2.0
C 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 granted to it by
C virtue of its status as an intergovernmental organisation nor does it submit to any jurisdiction.
C
C
C Fortran 77 Implementation: print_data_fortran
C
C Description: prints all the data contained in a grib file
C
C
C
C
program print_data_fortran
implicit none
integer maxNumberOfValues
parameter( maxNumberOfValues = 100000 )
include 'grib_api_f77.h'
integer ifile
integer iret
integer igrib
integer i
real*8 values(maxNumberOfValues)
integer*4 numberOfValues
real*8 average
real*8 max
real*8 min
character*256 error
integer*4 size
size=maxNumberOfValues
ifile=5
iret=grib_open_file(ifile
X,'../../data/constant_field.grib1','r')
call grib_check(iret)
C a new grib message is loaded from file
C igrib is the grib id to be used in subsequent calls
call grib_check( grib_new_from_file(ifile,igrib) )
C get the size of the values array
call grib_check(grib_get_size(igrib,'values',numberOfValues))
if ( numberOfValues .gt. maxNumberOfValues ) then
write(*,*)'ERROR: maxNumberOfValues too small numberOfValues=',
XnumberOfValues
stop
endif
C get data values
call grib_check(grib_get_real8_array(igrib,'values',values,size))
if ( size .ne. numberOfValues ) then
write(*,*) 'ERROR: wrong numberOfValues'
stop
endif
do i=1,numberOfValues
write(*,*)' ',i,values(i)
enddo
average =average / numberOfValues
write(*,*)numberOfValues,' values found '
call grib_check(grib_get_real8(igrib,'max',max))
write(*,*) 'max=',max
call grib_check(grib_get_real8(igrib,'min',min))
write(*,*) 'min=',min
call grib_check(grib_get_real8(igrib,'average',average))
write(*,*) 'average=',average
call grib_check(grib_release(igrib))
call grib_check(grib_close_file(ifile))
end

78
examples/F77/msg_fortran.F
View File

@ -1,78 +0,0 @@
C Copyright 2005-2016 ECMWF.
C
C This software is licensed under the terms of the Apache Licence Version 2.0
C 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 granted to it by
C virtue of its status as an intergovernmental organisation nor does it submit to any jurisdiction.
C
C
C
C Fortran 77 Implementation: set_fortran
C
C Description: how to set key values.
C
C
C
C
C
program set
implicit none
integer MAX_MSG_LEN
parameter (MAX_MSG_LEN=100000)
include 'grib_api_f77.h'
integer err
integer*4 centre
integer*4 int_value
character*10 string_value
character*20 string_centre
integer len
integer size
integer infile,outfile
integer igrib,iret
character*256 error
integer buffer(MAX_MSG_LEN)
integer buflen
infile=5
outfile=6
call grib_check(grib_open_file(infile
X,'../../data/regular_latlon_surface.grib1','r'))
c call grib_check(grib_open_file(outfile
c X,'../../data/out.grib1','w'))
C a new grib message is loaded from file
C igrib is the grib id to be used in subsequent calls
call grib_check(grib_new_from_file(infile,igrib))
C set centre as a long */
centre=80
call grib_check(grib_set_int(igrib,'centre',centre))
C get centre as a integer*4
call grib_check(grib_get_int(igrib,'centre',int_value))
write(*,*) 'centre=',int_value
C get centre as a string
call grib_check(grib_get_string(igrib,'centre',string_value))
string_centre='centre='//string_value
write(*,*) string_centre
call grib_copy_message(igrib,buffer,bufflen)
c
c .... do something with buffer
c
C write modified message to a file
c call grib_check(grib_write(igrib,outfile))
call grib_check(grib_release(igrib))
call grib_check(grib_close_file(infile))
c call grib_check(grib_close_file(outfile))
end

78
examples/F77/multi_fortran.F
View File

@ -1,78 +0,0 @@
C Copyright 2005-2016 ECMWF.
C
C This software is licensed under the terms of the Apache Licence Version 2.0
C 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 granted to it by
C virtue of its status as an intergovernmental organisation nor does it submit to any jurisdiction.
C
C
C
C Fortran 77 Implementation: multi_fortran
C
C Description: How to decode grib messages containing multiple
C fields. Try to turn on and off multi support to
C see the difference. Default is OFF.
C For all the tools defalut is multi support ON.
C
C
C
C
C
program multi
implicit none
include 'grib_api_f77.h'
integer iret
character*256 error
integer*4 parameterCategory,parameterNumber,discipline
integer ifile,igrib
call grib_check( grib_open_file(ifile
X,'../../data/multi.grib2','r'))
C turn on support for multi fields messages */
call grib_check(grib_multi_support_on())
C turn off support for multi fields messages */
C call grib_check(grib_multi_support_off())
C Loop on all the messages in a file.
10 iret=grib_new_from_file(ifile,igrib)
if (igrib .eq. -1 ) then
if (iret .ne.0) then
call grib_check(iret)
endif
stop
endif
C get as a integer*4
call grib_check(grib_get_int(igrib,'discipline',discipline))
write(*,*) 'discipline=',discipline
C get as a integer*4
call grib_check(grib_get_int(igrib,'parameterCategory'
X,parameterCategory))
write(*,*) 'parameterCategory=',parameterCategory
C get as a integer*4
call grib_check(grib_get_int(igrib,'parameterNumber'
X,parameterNumber))
write(*,*) 'parameterNumber=',parameterNumber
if ( discipline .eq. 0 .and. parameterCategory .eq. 2) then
if (parameterNumber .eq. 2) then
write(*,*) "-------- u -------"
endif
if (parameterNumber .eq. 3) then
write(*,*) "-------- v -------"
endif
endif
goto 10
call grib_check(grib_release(igrib))
call grib_check(grib_close_file(ifile))
end

13
examples/F77/multi_fortran.sh
View File

@ -1,13 +0,0 @@
#!/bin/sh
. ./include.sh
if [ ! -f "${data_dir}/multi.grib2" ]
then
echo SKIP: $0
exit
fi
${examples_dir}multi_fortran > /dev/null

77
examples/F77/nearest_fortran.F
View File

@ -1,77 +0,0 @@
C Copyright 2005-2016 ECMWF.
C
C This software is licensed under the terms of the Apache Licence Version 2.0
C 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 granted to it by
C virtue of its status as an intergovernmental organisation nor does it submit to any jurisdiction.
C
C Fortran Implementation: fieldset
C
C Description: how to use a fieldset.
C
C
C
C
C
program nearest
implicit none
include 'grib_api_f77.h'
integer err
integer step
integer nfiles
integer i
integer iset
integer ig
character*20 param
integer len
real*8 lats
real*8 lons
real*8 values
real*8 distances
integer indexes
integer size
real*8 lat,lon
integer mode=0
integer count
character*200 filenames
dimension filenames(5)
integer in
nfiles=argc-1;
filenames=(char**)malloc(sizeof(char*)*nfiles);
for (i=0;i<nfiles;i++)
filenames[i]=(char*)strdup(argv[i+1]);
set=grib_fieldset_new_from_files(0,filenames,nfiles,0,0,0,order_by,&err);
GRIB_CHECK(err,0);
printf("\nordering by %s\n",order_by);
printf("\n%d fields in the fieldset\n",grib_fieldset_count(set));
printf("n,step,param\n");
mode=GRIB_NEAREST_SAME_GRID | GRIB_NEAREST_SAME_POINT;
count=1;
while ((h=grib_fieldset_next_handle(set,&err))!=NULL) {
GRIB_CHECK(grib_get_long(h,"step",&step),0);
GRIB_CHECK(grib_get_string(h,"param",param,&len),0);
printf("%d %ld %s ",count,step,param);
if (!nearest) nearest=grib_nearest_new(h,&err);
GRIB_CHECK(err,0);
GRIB_CHECK(grib_nearest_find(nearest,h,lat,lon,mode,lats,lons,values,distances,indexes,&size),0);
for (i=0;i<4;i++) printf("%d %.2f %.2f %g %g - ",
(int)indexes[i],lats[i],lons[i],distances[i],values[i]);
printf("\n");
grib_handle_delete(h);
count++;
}
if (nearest) grib_nearest_delete(nearest);
if (set) grib_fieldset_delete(set);
return 0;
}

97
examples/F77/precision_fortran.F
View File

@ -1,97 +0,0 @@
C Copyright 2005-2016 ECMWF.
C
C This software is licensed under the terms of the Apache Licence Version 2.0
C 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 granted to it by
C virtue of its status as an intergovernmental organisation nor does it submit to any jurisdiction.
C
C
C
C Fortran 77 Implementation: precision
C
C Description: how to control decimal precision when packing fields.
C
C
C
C
C
program precision
implicit none
integer maxNumberOfValues
parameter (maxNumberOfValues=10000)
include 'grib_api_f77.h'
integer*4 size
integer infile,outfile
integer igrib
real*8 values1(maxNumberOfValues)
real*8 values2(maxNumberOfValues)
real*8 maxa,a,maxv,minv,maxr,r
integer*4 decimalPrecision,bitsPerValue1,bitsPerValue2
integer i
call grib_check(grib_open_file(infile
X,'../../data/regular_latlon_surface.grib1','r'))
call grib_check(grib_open_file(outfile
X,'../../data/regular_latlon_surface_prec.grib1','w'))
C a new grib message is loaded from file
C igrib is the grib id to be used in subsequent calls
call grib_check(grib_new_from_file(infile,igrib))
C bitsPerValue before changing the packing parameters
call grib_check(grib_get_int(igrib,'bitsPerValue',bitsPerValue1))
C get the size of the values array
call grib_check(grib_get_size(igrib,"values",size))
C get data values before changing the packing parameters*/
call grib_check(grib_get_real8_array(igrib,"values",values1,size))
C setting decimal precision=2 means that 2 decimal digits
C are preserved when packing.
decimalPrecision=2
call grib_check(grib_set_int(igrib,"changeDecimalPrecision"
X,decimalPrecision))
C bitsPerValue after changing the packing parameters
call grib_check(grib_get_int(igrib,"bitsPerValue",bitsPerValue2))
C get data values after changing the packing parameters
call grib_check(grib_get_real8_array(igrib,"values",values2,size))
C computing error
maxa=0
maxr=0
maxv=values2(1)
minv=maxv
do i=1,size
a=abs(values2(i)-values1(i))
if ( values2(i) .gt. maxv ) maxv=values2(i)
if ( values2(i) .lt. maxv ) minv=values2(i)
if ( values2(i) .ne. 0 ) then
r=abs((values2(i)-values1(i))/values2(i))
endif
if ( a .gt. maxa ) maxa=a
if ( r .gt. maxr ) maxr=r
enddo
write(*,*) "max absolute error = ",maxa
write(*,*) "max relative error = ",maxr
write(*,*) "min value = ",minv
write(*,*) "max value = ",maxv
write(*,*) "old number of bits per value=",bitsPerValue1
write(*,*) "new number of bits per value=",bitsPerValue2
C write modified message to a file
call grib_check(grib_write(igrib,outfile))
call grib_check(grib_release(igrib))
call grib_check(grib_close_file(infile))
call grib_check(grib_close_file(outfile))
end

7
examples/F77/precision_fortran.sh
View File

@ -1,7 +0,0 @@
#!/bin/sh
. ./include.sh
${examples_dir}precision_fortran > /dev/null

80
examples/F77/print_data_fortran.F
View File

@ -1,80 +0,0 @@
C Copyright 2005-2016 ECMWF.
C
C This software is licensed under the terms of the Apache Licence Version 2.0
C 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 granted to it by
C virtue of its status as an intergovernmental organisation nor does it submit to any jurisdiction.
C
C
C Fortran 77 Implementation: print_data_fortran
C
C Description: prints all the data contained in a grib file
C
C
C
C
program print_data_fortran
implicit none
integer maxNumberOfValues
parameter( maxNumberOfValues = 100000 )
include 'grib_api_f77.h'
integer ifile
integer iret
integer igrib
integer i
real*8 values(maxNumberOfValues)
integer*4 numberOfValues
real*8 average
real*8 max
real*8 min
character*256 error
integer*4 size
size=maxNumberOfValues
ifile=5
iret=grib_open_file(ifile
X,'../../data/constant_field.grib1','r')
call grib_check(iret)
C a new grib message is loaded from file
C igrib is the grib id to be used in subsequent calls
call grib_check( grib_new_from_file(ifile,igrib) )
C get the size of the values array
call grib_check(grib_get_size(igrib,'values',numberOfValues))
if ( numberOfValues .gt. maxNumberOfValues ) then
write(*,*)'ERROR: maxNumberOfValues too small numberOfValues=',
XnumberOfValues
stop
endif
C get data values
call grib_check(grib_get_real8_array(igrib,'values',values,size))
if ( size .ne. numberOfValues ) then
write(*,*) 'ERROR: wrong numberOfValues'
stop
endif
do i=1,numberOfValues
write(*,*)' ',i,values(i)
enddo
average =average / numberOfValues
write(*,*)numberOfValues,' values found '
call grib_check(grib_get_real8(igrib,'max',max))
write(*,*) 'max=',max
call grib_check(grib_get_real8(igrib,'min',min))
write(*,*) 'min=',min
call grib_check(grib_get_real8(igrib,'average',average))
write(*,*) 'average=',average
call grib_check(grib_release(igrib))
call grib_check(grib_close_file(ifile))
end

13
examples/F77/print_data_fortran.sh
View File

@ -1,13 +0,0 @@
#!/bin/sh
. ./include.sh
numberOfValues=`${examples_dir}print_data_fortran | grep values | awk '{print $1}'`
if [ $numberOfValues -ne 99200 ]
then
echo ERROR: wrong number of values
exit 1;
fi

68
examples/F77/set_fortran.F
View File

@ -1,68 +0,0 @@
C Copyright 2005-2016 ECMWF.
C
C This software is licensed under the terms of the Apache Licence Version 2.0
C 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 granted to it by
C virtue of its status as an intergovernmental organisation nor does it submit to any jurisdiction.
C
C
C
C Fortran 77 Implementation: set_fortran
C
C Description: how to set key values.
C
C
C
C
C
program set
implicit none
include 'grib_api_f77.h'
integer err
integer*4 centre
integer*4 int_value
character*10 string_value
character*20 string_centre
integer len
integer size
integer infile,outfile
integer igrib,iret
character*256 error
infile=5
outfile=6
call grib_check(grib_open_file(infile
X,'../../data/regular_latlon_surface.grib1','r'))
call grib_check(grib_open_file(outfile
X,'../../data/out.grib1','w'))
C a new grib message is loaded from file
C igrib is the grib id to be used in subsequent calls
call grib_check(grib_new_from_file(infile,igrib))
C set centre as a long */
centre=80
call grib_check(grib_set_int(igrib,'centre',centre))
C get centre as a integer*4
call grib_check(grib_get_int(igrib,'centre',int_value))
write(*,*) 'centre=',int_value
C get centre as a string
call grib_check(grib_get_string(igrib,'centre',string_value))
string_centre='centre='//string_value
write(*,*) string_centre
C write modified message to a file
call grib_check(grib_write(igrib,outfile))
call grib_check(grib_release(igrib))
call grib_check(grib_close_file(infile))
call grib_check(grib_close_file(outfile))
end

8
examples/F77/set_fortran.sh
View File

@ -1,8 +0,0 @@
#!/bin/sh
. ./include.sh
${examples_dir}set_fortran > /dev/null
${examples_dir}set_missing_fortran > /dev/null

62
examples/F77/set_missing_fortran.F
View File

@ -1,62 +0,0 @@
C Copyright 2005-2016 ECMWF.
C
C This software is licensed under the terms of the Apache Licence Version 2.0
C 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 granted to it by
C virtue of its status as an intergovernmental organisation nor does it submit to any jurisdiction.
C
C
C
C Fortran 77 Implementation: set_missing_fortran
C
C Description: how to set a key as missing.
C
C
C
C
C
program set
implicit none
include 'grib_api_f77.h'
integer err
character*6 string_value
integer infile,outfile
integer igrib,iret
character*256 error
integer len
infile=5
outfile=6
string_value='sfc'
len=3
call grib_check(grib_open_file(infile
X,'../../data/reduced_gaussian_pressure_level.grib2','r'))
call grib_check(grib_open_file(outfile
X,'out_surface_level.grib2','w'))
C a new grib message is loaded from file
C igrib is the grib id to be used in subsequent calls
call grib_check(grib_new_from_file(infile,igrib))
call grib_check(grib_set_string(igrib,
X'typeOfFirstFixedSurface', string_value))
call grib_check(grib_set_missing(igrib,
X'scaleFactorOfFirstFixedSurface'))
call grib_check(grib_set_missing(igrib,
X'scaledValueOfFirstFixedSurface'))
C write modified message to a file
call grib_check(grib_write(igrib,outfile))
call grib_check(grib_release(igrib))
call grib_check(grib_close_file(infile))
call grib_check(grib_close_file(outfile))
end

55
examples/F77/set_pv_fortran.F
View File

@ -1,55 +0,0 @@
C Copyright 2005-2016 ECMWF.
C
C This software is licensed under the terms of the Apache Licence Version 2.0
C 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 granted to it by
C virtue of its status as an intergovernmental organisation nor does it submit to any jurisdiction.
C
C
C
C Fortran 77 Implementation: set_fortran
C
C Description: how to set pv values.
C
C
C
C
C
program set
implicit none
include 'grib_api_f77.h'
integer err
integer infile,outfile
integer igrib,iret
character*256 error
real*8 pv
integer pvsize
dimension pv(4)
pvsize=4
infile=5
outfile=6
call grib_check(grib_open_file(infile
X,'../../data/regular_latlon_surface.grib1','r'))
call grib_check(grib_open_file(outfile,'out.grib1','w'))
C a new grib message is loaded from file
C igrib is the grib id to be used in subsequent calls
call grib_check(grib_new_from_file(infile,igrib))
call grib_check(grib_set_int(igrib,'PVPresent',1))
call grib_check(grib_set_real8_array(igrib,'pv',pv,pvsize))
C write modified message to a file
call grib_check(grib_write(igrib,outfile))
call grib_check(grib_release(igrib))
call grib_check(grib_close_file(infile))
call grib_check(grib_close_file(outfile))
end