Kezdõlap GRIBEX példaprogram

A program kódja letölthető itt
  PROGRAM GRDEMO
IMPLICIT NONE
GRDEMO - Bemutató program a GRIBEX használatához

Kiolvassa a GRIB messageban tárolt adatokat, képernyőre íratja
szekciónként, a "hasznos adatokat" az output.dat fájlba íratja ki

A WMO GRIB kódolási definíció alapján működik
A WMO Publication No. 9, Volume B katalógus táblázatot használja
a GRIB fájlban lévő adatok azonosítására

INTEGER JPACK, JPBYTES
PARAMETER (JPACK=280000)
PARAMETER (JPBYTES=4)

Skalár argumentek a GRIBEX híváshoz

INTEGER KSEC0(2)
INTEGER KSEC1(1024)
INTEGER KSEC2(1024)
INTEGER KSEC3(2)
INTEGER KSEC4(512)

Valós argumentek a GRIBEX híváshoz

REAL PSEC2(512)
REAL PSEC3(2)
REAL PSEC4(JPACK*5)

A GRIB produktumot tároló vektor:

INTEGER KGRIB
DIMENSION KGRIB(JPACK)

INTEGER FILE, JCOUNT, NUMERR, KLENG, LENOUT
INTEGER KLENP, KRET, KWORD, LOOP
OPEN (10,file='output.dat',form='formatted',access='sequential')

Bemenő GRIB file megnyitása

CALL PBOPEN( FILE, 'output.grib', 'r', KRET)
IF( KRET.NE.0 ) THEN
WRITE (*, *) 'GRDEMO: Return code from PBOPEN = ',KRET
CALL PBCLOSE(FILE, KRET)
STOP 'Fault in PBOPEN'
ENDIF

A GRIB fájlban levő rekordok számát tárolja:

NUMERR = 0
JCOUNT = 0

CONTINUE

A rekordszám növelése:

JCOUNT = JCOUNT + 1

A GRIB-kódolt mezőt a KGRIB-be olvassa

KLENG = JPACK*JPBYTES
CALL PBGRIB( FILE, KGRIB, KLENG, LENOUT, KRET )
IF( KRET.LT.0 ) THEN
IF( KRET.EQ.-1 ) THEN
WRITE (*, *) 'GRDEMO: End of file.'
WRITE(*,*) 'GRDEMO: Number of products =',(JCOUNT-1)
CALL PBCLOSE(FILE, KRET)
WRITE (*,*) 'GRDEMO: Number of decoding errors = ',NUMERR
STOP 'EOF'
ELSE
WRITE (*, *) 'GRDEMO: Return code from PBGRIB = ',KRET
WRITE (*, *) 'GRDEMO: after ', JCOUNT,' products.'
CALL PBCLOSE(FILE, KRET)
STOP 'Fault in PBGRIB'
ENDIF
ENDIF
WRITE (*, *) 'GRDEMO: Return length from PBGRIB = ',LENOUT

A "GRIB messgage"-k kitömörítése (dekódolása)

KLENG = (LENOUT+JPBYTES-1)/JPBYTES
KLENP = JPACK*5
KRET = 1
CALL GRIBEX(KSEC0,KSEC1,KSEC2,PSEC2,KSEC3,PSEC3,KSEC4,
PSEC4,KLENP,KGRIB,KLENG,KWORD,'D',KRET)

Ellenőrzés a visszaadott kód alapján

WRITE (*,*) 'GRDEMO: GRIBEX return code = ',KRET
IF( KRET.EQ.-6 ) WRITE (*,*) 'GRDEMO: Pseudo-grib data found.'
IF( KRET.GT.0 ) THEN
NUMERR = NUMERR + 1
GOTO 50
ENDIF

Kiíratja a 0, 1, 2, 3.-ik (ha van) és 4.-ik szekciót
Az első szekció a produktum definíciós szekciója
A második a grid definíciós szekció
A harmadik a bitmap szekció
A negyedik szekció az adatok szekciója

CALL GRPRS0(KSEC0)
CALL GRPRS1(KSEC0,KSEC1)

IF( (KSEC1(5).EQ.0).OR.(KSEC1(5).EQ.64) ) THEN
WRITE (*,*) 'GRDEMO: No section 2 in GRIB message.'
ELSE
CALL GRPRS2(KSEC0,KSEC2,PSEC2)
ENDIF

IF( (KSEC1(5).EQ.0).OR.(KSEC1(5).EQ.128) ) THEN
WRITE (*,*) 'GRDEMO: No section 3 in GRIB message.'
ELSE
CALL GRPRS3(KSEC0,KSEC3,PSEC3)
ENDIF

CALL GRPRS4(KSEC0,KSEC4,PSEC4)

A GRIB adatokat íratja ki fájlba

WRITE(*,*) 'Data values for product ', JCOUNT
DO LOOP = 1, KSEC4(1)
WRITE(10,*) PSEC4(LOOP)
ENDDO

A következő rekordra ugrik (ha van):

GOTO 50
close(10)
END