C-----------------------------------------------------------------------
SUBROUTINE IXGB2(LUGB,LSKIP,LGRIB,CBUF,NUMFLD,MLEN,IRET) 1,22
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: IXGB2 MAKE INDEX RECORDS FOR FIELDS IN A GRIB2 MESSAGE
C PRGMMR: GILBERT ORG: W/NP11 DATE: 2001-12-10
C
C ABSTRACT: THIS SUBPROGRAM GENERATES AN INDEX RECORD FOR EACH FIELD IN A
C GRIB2 MESSAGE. THE INDEX RECORDS ARE WRITTEN TO INDEX BUFFER
C POINTED TO BY CBUF.
C
C EACH INDEX RECORD HAS THE FOLLOWING FORM:
C BYTE 001 - 004: LENGTH OF INDEX RECORD
C BYTE 005 - 008: BYTES TO SKIP IN DATA FILE BEFORE GRIB MESSAGE
C BYTE 009 - 012: BYTES TO SKIP IN MESSAGE BEFORE LUS (LOCAL USE)
C SET = 0, IF NO LOCAL USE SECTION IN GRIB2 MESSAGE.
C BYTE 013 - 016: BYTES TO SKIP IN MESSAGE BEFORE GDS
C BYTE 017 - 020: BYTES TO SKIP IN MESSAGE BEFORE PDS
C BYTE 021 - 024: BYTES TO SKIP IN MESSAGE BEFORE DRS
C BYTE 025 - 028: BYTES TO SKIP IN MESSAGE BEFORE BMS
C BYTE 029 - 032: BYTES TO SKIP IN MESSAGE BEFORE DATA SECTION
C BYTE 033 - 040: BYTES TOTAL IN THE MESSAGE
C BYTE 041 - 041: GRIB VERSION NUMBER ( CURRENTLY 2 )
C BYTE 042 - 042: MESSAGE DISCIPLINE
C BYTE 043 - 044: FIELD NUMBER WITHIN GRIB2 MESSAGE
C BYTE 045 - II: IDENTIFICATION SECTION (IDS)
C BYTE II+1- JJ: GRID DEFINITION SECTION (GDS)
C BYTE JJ+1- KK: PRODUCT DEFINITION SECTION (PDS)
C BYTE KK+1- LL: THE DATA REPRESENTATION SECTION (DRS)
C BYTE LL+1-LL+6: FIRST 6 BYTES OF THE BIT MAP SECTION (BMS)
C
C PROGRAM HISTORY LOG:
C 95-10-31 IREDELL
C 96-10-31 IREDELL AUGMENTED OPTIONAL DEFINITIONS TO BYTE 320
C 2001-12-10 GILBERT MODIFIED FROM IXGB TO CREATE GRIB2 INDEXES
C 2002-01-31 GILBERT ADDED IDENTIFICATION SECTION TO INDEX RECORD
C
C USAGE: CALL IXGB2(LUGB,LSKIP,LGRIB,CBUF,NUMFLD,MLEN,IRET)
C INPUT ARGUMENTS:
C LUGB INTEGER LOGICAL UNIT OF INPUT GRIB FILE
C LSKIP INTEGER NUMBER OF BYTES TO SKIP BEFORE GRIB MESSAGE
C LGRIB INTEGER NUMBER OF BYTES IN GRIB MESSAGE
C OUTPUT ARGUMENTS:
C CBUF CHARACTER*1 POINTER TO A BUFFER THAT CONTAINS INDEX RECORDS.
C USERS SHOULD FREE MEMORY THAT CBUF POINTS TO
C USING DEALLOCATE(CBUF) WHEN CBUF IS NO LONGER NEEDED.
C NUMFLD INTEGER NUMBER OF INDEX RECORDS CREATED.
C = 0, IF PROBLEMS
C MLEN INTEGER TOTAL LENGTH OF ALL INDEX RECORDS
C IRET INTEGER RETURN CODE
C =0, ALL OK
C =1, NOT ENOUGH MEMORY TO ALLOCATE INITIAL INDEX BUFFER
C =2, I/O ERROR IN READ
C =3, GRIB MESSAGE IS NOT EDITION 2
C =4, NOT ENOUGH MEMORY TO ALLOCATE EXTENT TO INDEX BUFFER
C =5, UNIDENTIFIED GRIB SECTION ENCOUNTERED...PROBLEM
C SOMEWHERE.
C
C SUBPROGRAMS CALLED:
C GBYTE GET INTEGER DATA FROM BYTES
C SBYTE STORE INTEGER DATA IN BYTES
C BAREAD BYTE-ADDRESSABLE READ
C REALLOC RE-ALLOCATES MORE MEMORY
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 90
C
C$$$
USE RE_ALLOC
! NEEDED FOR SUBROUTINE REALLOC
CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF
PARAMETER(LINMAX=5000,INIT=50000,NEXT=10000)
PARAMETER(IXSKP=4,IXLUS=8,IXSGD=12,IXSPD=16,IXSDR=20,IXSBM=24,
& IXDS=28,IXLEN=36,IXFLD=42,IXIDS=44)
PARAMETER(MXSKP=4,MXLUS=4,MXSGD=4,MXSPD=4,MXSDR=4,MXSBM=4,
& MXDS=4,MXLEN=4,MXFLD=2,MXBMS=6)
CHARACTER CBREAD(LINMAX),CINDEX(LINMAX)
CHARACTER CVER,CDISC
CHARACTER CIDS(LINMAX),CGDS(LINMAX),CBMS(6)
CHARACTER(LEN=4) :: CTEMP
INTEGER LOCLUS,LOCGDS,LENGDS,LOCBMS
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
LOCLUS=0
IRET=0
MLEN=0
NUMFLD=0
IF (ASSOCIATED(CBUF)) NULLIFY(CBUF)
MBUF=INIT
ALLOCATE(CBUF(MBUF),STAT=ISTAT) ! ALLOCATE INITIAL SPACE FOR CBUF
IF (ISTAT.NE.0) THEN
IRET=1
RETURN
ENDIF
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C READ SECTIONS 0 AND 1 FOR VERSIN NUMBER AND DISCIPLINE
IBREAD=MIN(LGRIB,LINMAX)
CALL BAREAD(LUGB,LSKIP,IBREAD,LBREAD,CBREAD)
IF(LBREAD.NE.IBREAD) THEN
IRET=2
RETURN
ENDIF
IF(CBREAD(8).NE.CHAR(2)) THEN ! NOT GRIB EDITION 2
IRET=3
RETURN
ENDIF
CVER=CBREAD(8)
CDISC=CBREAD(7)
CALL GBYTE(CBREAD,LENSEC1,16*8,4*8)
LENSEC1=MIN(LENSEC1,IBREAD)
CIDS(1:LENSEC1)=CBREAD(17:16+LENSEC1)
IBSKIP=LSKIP+16+LENSEC1
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C LOOP THROUGH REMAINING SECTIONS CREATING AN INDEX FOR EACH FIELD
IBREAD=MAX(5,MXBMS)
DO
CALL BAREAD(LUGB,IBSKIP,IBREAD,LBREAD,CBREAD)
CTEMP=CBREAD(1)//CBREAD(2)//CBREAD(3)//CBREAD(4)
IF (CTEMP.EQ.'7777') RETURN ! END OF MESSAGE FOUND
IF(LBREAD.NE.IBREAD) THEN
IRET=2
RETURN
ENDIF
CALL GBYTE(CBREAD,LENSEC,0*8,4*8)
CALL GBYTE(CBREAD,NUMSEC,4*8,1*8)
IF (NUMSEC.EQ.2) THEN ! SAVE LOCAL USE LOCATION
LOCLUS=IBSKIP-LSKIP
ELSEIF (NUMSEC.EQ.3) THEN ! SAVE GDS INFO
LENGDS=LENSEC
CGDS=CHAR(0)
CALL BAREAD(LUGB,IBSKIP,LENGDS,LBREAD,CGDS)
IF(LBREAD.NE.LENGDS) THEN
IRET=2
RETURN
ENDIF
LOCGDS=IBSKIP-LSKIP
ELSEIF (NUMSEC.EQ.4) THEN ! FOUND PDS
CINDEX=CHAR(0)
CALL SBYTE(CINDEX,LSKIP,8*IXSKP,8*MXSKP) ! BYTES TO SKIP
CALL SBYTE(CINDEX,LOCLUS,8*IXLUS,8*MXLUS) ! LOCATION OF LOCAL USE
CALL SBYTE(CINDEX,LOCGDS,8*IXSGD,8*MXSGD) ! LOCATION OF GDS
CALL SBYTE(CINDEX,IBSKIP-LSKIP,8*IXSPD,8*MXSPD) ! LOCATION OF PDS
CALL SBYTE(CINDEX,LGRIB,8*IXLEN,8*MXLEN) ! LEN OF GRIB2
CINDEX(41)=CVER
CINDEX(42)=CDISC
CALL SBYTE(CINDEX,NUMFLD+1,8*IXFLD,8*MXFLD) ! FIELD NUM
CINDEX(IXIDS+1:IXIDS+LENSEC1)=CIDS(1:LENSEC1)
LINDEX=IXIDS+LENSEC1
CINDEX(LINDEX+1:LINDEX+LENGDS)=CGDS(1:LENGDS)
LINDEX=LINDEX+LENGDS
ILNPDS=LENSEC
CALL BAREAD(LUGB,IBSKIP,ILNPDS,LBREAD,CINDEX(LINDEX+1))
IF(LBREAD.NE.ILNPDS) THEN
IRET=2
RETURN
ENDIF
! CINDEX(LINDEX+1:LINDEX+ILNPDS)=CBREAD(1:ILNPDS)
LINDEX=LINDEX+ILNPDS
ELSEIF (NUMSEC.EQ.5) THEN ! FOUND DRS
CALL SBYTE(CINDEX,IBSKIP-LSKIP,8*IXSDR,8*MXSDR) ! LOCATION OF DRS
ILNDRS=LENSEC
CALL BAREAD(LUGB,IBSKIP,ILNDRS,LBREAD,CINDEX(LINDEX+1))
IF(LBREAD.NE.ILNDRS) THEN
IRET=2
RETURN
ENDIF
! CINDEX(LINDEX+1:LINDEX+ILNDRS)=CBREAD(1:ILNDRS)
LINDEX=LINDEX+ILNDRS
ELSEIF (NUMSEC.EQ.6) THEN ! FOUND BMS
INDBMP=MOVA2I(CBREAD(6))
IF ( INDBMP.LT.254 ) THEN
LOCBMS=IBSKIP-LSKIP
CALL SBYTE(CINDEX,LOCBMS,8*IXSBM,8*MXSBM) ! LOC. OF BMS
ELSEIF ( INDBMP.EQ.254 ) THEN
CALL SBYTE(CINDEX,LOCBMS,8*IXSBM,8*MXSBM) ! LOC. OF BMS
ELSEIF ( INDBMP.EQ.255 ) THEN
CALL SBYTE(CINDEX,IBSKIP-LSKIP,8*IXSBM,8*MXSBM) ! LOC. OF BMS
ENDIF
CINDEX(LINDEX+1:LINDEX+MXBMS)=CBREAD(1:MXBMS)
LINDEX=LINDEX+MXBMS
CALL SBYTE(CINDEX,LINDEX,0,8*4) ! NUM BYTES IN INDEX RECORD
ELSEIF (NUMSEC.EQ.7) THEN ! FOUND DATA SECTION
CALL SBYTE(CINDEX,IBSKIP-LSKIP,8*IXDS,8*MXDS) ! LOC. OF DATA SEC.
NUMFLD=NUMFLD+1
IF ((LINDEX+MLEN).GT.MBUF) THEN ! ALLOCATE MORE SPACE IF
! NECESSARY
NEWSIZE=MAX(MBUF+NEXT,MBUF+LINDEX)
CALL REALLOC(CBUF,MLEN,NEWSIZE,ISTAT)
IF ( ISTAT .NE. 0 ) THEN
NUMFLD=NUMFLD-1
IRET=4
RETURN
ENDIF
MBUF=NEWSIZE
ENDIF
CBUF(MLEN+1:MLEN+LINDEX)=CINDEX(1:LINDEX)
MLEN=MLEN+LINDEX
ELSE ! UNRECOGNIZED SECTION
IRET=5
RETURN
ENDIF
IBSKIP=IBSKIP+LENSEC
ENDDO
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
RETURN
END