SUBROUTINE GETGB1(LUGB,LUGI,JF,J,JPDS,JGDS,
& GRIB,KF,K,KPDS,KGDS,LB,F,IRET)
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: GETGB1 FINDS AND UNPACKS A GRIB MESSAGE
C PRGMMR: IREDELL ORG: W/NMC23 DATE: 94-04-01
C
C ABSTRACT: FIND AND UNPACK A GRIB MESSAGE.
C READ AN ASSOCIATED GRIB INDEX FILE (UNLESS IT ALREADY WAS READ).
C FIND IN THE INDEX FILE A REFERENCE TO THE GRIB MESSAGE REQUESTED.
C THE GRIB MESSAGE REQUEST SPECIFIES THE NUMBER OF MESSAGES TO SKIP
C AND THE UNPACKED PDS AND GDS PARAMETERS. (A REQUESTED PARAMETER
C OF -1 MEANS TO ALLOW ANY VALUE OF THIS PARAMETER TO BE FOUND.)
C IF THE REQUESTED GRIB MESSAGE IS FOUND, THEN IT IS READ FROM THE
C GRIB FILE AND UNPACKED. ITS MESSAGE NUMBER IS RETURNED ALONG WITH
C THE UNPACKED PDS AND GDS PARAMETERS, THE UNPACKED BITMAP (IF ANY),
C AND THE UNPACKED DATA. IF THE GRIB MESSAGE IS NOT FOUND, THEN THE
C RETURN CODE WILL BE NONZERO.
C
C PROGRAM HISTORY LOG:
C 94-04-01 IREDELL
C 95-05-10 R.E.JONES ADD ONE MORE PARAMETER TO GETGB AND
C CHANGE NAME TO GETGB1
C
C USAGE: CALL GETGB1(LUGB,LUGI,JF,J,JPDS,JGDS,
C & GRIB,KF,K,KPDS,KGDS,LB,F,IRET)
C INPUT ARGUMENTS:
C LUGB LOGICAL UNIT OF THE UNBLOCKED GRIB DATA FILE
C LUGI LOGICAL UNIT OF THE UNBLOCKED GRIB INDEX FILE
C JF INTEGER MAXIMUM NUMBER OF DATA POINTS TO UNPACK
C J INTEGER NUMBER OF MESSAGES TO SKIP
C (=0 TO SEARCH FROM BEGINNING)
C (<0 TO REOPEN INDEX FILE AND SEARCH FROM BEGINNING)
C JPDS INTEGER (25) PDS PARAMETERS FOR WHICH TO SEARCH
C (=-1 FOR WILDCARD)
C LOOK IN DOC BLOCK OF W3FI63 FOR ARRAY KPDS
C FOR LIST OF ORDER OF UNPACKED PDS VALUES. IN
C MOST CASES YOU ONLY NEED TO SET 4 OR 5 VALUES
C TO PICK UP RECORD.
C JGDS INTEGER (22) GDS PARAMETERS FOR WHICH TO SEARCH
C (ONLY SEARCHED IF JPDS(3)=255)
C (=-1 FOR WILDCARD)
C OUTPUT ARGUMENTS:
C GRIB GRIB DATA ARRAY BEFORE IT IS UNPACKED
C KF INTEGER NUMBER OF DATA POINTS UNPACKED
C K INTEGER MESSAGE NUMBER UNPACKED
C (CAN BE SAME AS J IN CALLING PROGRAM
C IN ORDER TO FACILITATE MULTIPLE SEARCHES)
C KPDS INTEGER (25) UNPACKED PDS PARAMETERS
C KGDS INTEGER (22) UNPACKED GDS PARAMETERS
C LB LOGICAL (KF) UNPACKED BITMAP IF PRESENT
C F REAL (KF) UNPACKED DATA
C IRET INTEGER RETURN CODE
C 0 ALL OK
C 96 ERROR READING INDEX FILE
C 97 ERROR READING GRIB FILE
C 98 NUMBER OF DATA POINTS GREATER THAN JF
C 99 REQUEST NOT FOUND
C OTHER W3FI63 GRIB UNPACKER RETURN CODE
C
C SUBPROGRAMS CALLED:
C BAREAD BYTE-ADDRESSABLE READ
C GBYTE UNPACK BYTES
C FI632 UNPACK PDS
C FI633 UNPACK GDS
C W3FI63 UNPACK GRIB
C
C ATTRIBUTES:
C LANGUAGE: CRAY CFT77 FORTRAN
C MACHINE: CRAY C916/256, J916/2048
C
C$$$
C
PARAMETER (MBUF=8192*128)
PARAMETER (LPDS=23,LGDS=22)
C
INTEGER JPDS(25),JGDS(*),KPDS(25),KGDS(*)
INTEGER IPDSP(LPDS),JPDSP(LPDS),IGDSP(LGDS)
INTEGER JGDSP(LGDS)
INTEGER KPTR(20)
C
LOGICAL LB(*)
C
REAL F(*)
C
CHARACTER CBUF(MBUF)
CHARACTER*81 CHEAD(2)
CHARACTER*1 CPDS(28)
CHARACTER*1 CGDS(42)
CHARACTER*1 GRIB(*)
C
C SAVE LUX,NSKP,NLEN,NNUM,CBUF
SAVE
C
DATA LUX/0/
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C READ INDEX FILE
IF(J.LT.0.OR.LUGI.NE.LUX) THEN
C REWIND LUGI
C READ(LUGI,fmt='(2A81)',IOSTAT=IOS) CHEAD
CALL BAREAD(LUGI,0,162,ios,chead)
IF(IOS.EQ.162.AND.CHEAD(1)(42:47).EQ.'GB1IX1') THEN
LUX=0
READ(CHEAD(2),'(8X,3I10,2X,A40)',IOSTAT=IOS) NSKP,NLEN,NNUM
IF(IOS.EQ.0) THEN
NBUF=NNUM*NLEN
IF(NBUF.GT.MBUF) THEN
PRINT *,'GETGB1: INCREASE BUFFER FROM ',MBUF,' TO ',NBUF
NNUM=MBUF/NLEN
NBUF=NNUM*NLEN
ENDIF
CALL BAREAD(LUGI,NSKP,NBUF,LBUF,CBUF)
IF(LBUF.EQ.NBUF) THEN
LUX=LUGI
J=MAX(J,0)
ENDIF
ENDIF
ENDIF
ENDIF
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C SEARCH FOR REQUEST
LGRIB=0
KJ=J
K=J
KF=0
IF(J.GE.0.AND.LUGI.EQ.LUX) THEN
LPDSP=0
DO I=1,LPDS
IF(JPDS(I).NE.-1) THEN
LPDSP=LPDSP+1
IPDSP(LPDSP)=I
JPDSP(LPDSP)=JPDS(I)
ENDIF
ENDDO
LGDSP=0
IF(JPDS(3).EQ.255) THEN
DO I=1,LGDS
IF(JGDS(I).NE.-1) THEN
LGDSP=LGDSP+1
IGDSP(LGDSP)=I
JGDSP(LGDSP)=JGDS(I)
ENDIF
ENDDO
ENDIF
IRET=99
DOWHILE(LGRIB.EQ.0.AND.KJ.LT.NNUM)
KJ=KJ+1
LT=0
IF(LPDSP.GT.0) THEN
CPDS=CBUF((KJ-1)*NLEN+26:(KJ-1)*NLEN+53)
KPTR=0
CALL GBYTE(CBUF,KPTR(3),(KJ-1)*NLEN*8+25*8,3*8)
CALL FI632(CPDS,KPTR,KPDS,IRET)
DO I=1,LPDSP
IP=IPDSP(I)
LT=LT+ABS(JPDS(IP)-KPDS(IP))
ENDDO
ENDIF
IF(LT.EQ.0.AND.LGDSP.GT.0) THEN
CGDS=CBUF((KJ-1)*NLEN+54:(KJ-1)*NLEN+95)
KPTR=0
CALL FI633(CGDS,KPTR,KGDS,IRET)
DO I=1,LGDSP
IP=IGDSP(I)
LT=LT+ABS(JGDS(IP)-KGDS(IP))
ENDDO
ENDIF
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C READ AND UNPACK GRIB DATA
IF(LT.EQ.0) THEN
CALL GBYTE(CBUF,LSKIP,(KJ-1)*NLEN*8,4*8)
CALL GBYTE(CBUF,LGRIB,(KJ-1)*NLEN*8+20*8,4*8)
CGDS=CBUF((KJ-1)*NLEN+54:(KJ-1)*NLEN+95)
KPTR=0
CALL FI633(CGDS,KPTR,KGDS,IRET)
C BSM IF(LGRIB.LE.200+17*JF/8.AND.KGDS(2)*KGDS(3).LE.JF) THEN
C Change number of bits that can be handled to 25
IF(LGRIB.LE.200+25*JF/8.AND.KGDS(2)*KGDS(3).LE.JF) THEN
CALL BAREAD(LUGB,LSKIP,LGRIB,LREAD,GRIB)
IF(LREAD.EQ.LGRIB) THEN
CALL W3FI63(GRIB,KPDS,KGDS,LB,F,KPTR,IRET)
IF(IRET.EQ.0) THEN
K=KJ
KF=KPTR(10)
ENDIF
ELSE
IRET=97
ENDIF
ELSE
IRET=98
ENDIF
ENDIF
ENDDO
ELSE
IRET=96
ENDIF
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
RETURN
END