C-----------------------------------------------------------------------
SUBROUTINE GETG2I(LUGI,CBUF,NLEN,NNUM,IRET) 2,2
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: GETG2I READS A GRIB2 INDEX FILE
C PRGMMR: IREDELL ORG: W/NMC23 DATE: 95-10-31
C
C ABSTRACT: READ A GRIB2 INDEX FILE AND RETURN ITS CONTENTS.
C VERSION 1 OF THE INDEX FILE HAS THE FOLLOWING FORMAT:
C 81-BYTE S.LORD HEADER WITH 'GB2IX1' IN COLUMNS 42-47 FOLLOWED BY
C 81-BYTE HEADER WITH NUMBER OF BYTES TO SKIP BEFORE INDEX RECORDS,
C TOTAL LENGTH IN BYTES OF THE INDEX RECORDS, NUMBER OF INDEX RECORDS,
C AND GRIB FILE BASENAME WRITTEN IN FORMAT ('IX1FORM:',3I10,2X,A40).
C EACH FOLLOWING INDEX RECORD CORRESPONDS TO A GRIB MESSAGE
C AND HAS THE INTERNAL FORMAT:
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 2002-01-03 GILBERT MODIFIED FROM GETGI TO WORK WITH GRIB2
C
C USAGE: CALL GETG2I(LUGI,CBUF,NLEN,NNUM,IRET)
C INPUT ARGUMENTS:
C LUGI INTEGER UNIT OF THE UNBLOCKED GRIB INDEX FILE
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 NLEN INTEGER TOTAL LENGTH OF ALL INDEX RECORDS
C NNUM INTEGER NUMBER OF INDEX RECORDS
C IRET INTEGER RETURN CODE
C 0 ALL OK
C 2 NOT ENOUGH MEMORY TO HOLD INDEX BUFFER
C 3 ERROR READING INDEX FILE BUFFER
C 4 ERROR READING INDEX FILE HEADER
C
C SUBPROGRAMS CALLED:
C BAREAD BYTE-ADDRESSABLE READ
C
C REMARKS: SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT.
C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR.
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 90
C
C$$$
CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF
INTEGER,INTENT(IN) :: LUGI
INTEGER,INTENT(OUT) :: NLEN,NNUM,IRET
CHARACTER CHEAD*162
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
IF (ASSOCIATED(CBUF)) NULLIFY(CBUF)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
NLEN=0
NNUM=0
IRET=4
CALL BAREAD
(LUGI,0,162,LHEAD,CHEAD)
IF(LHEAD.EQ.162.AND.CHEAD(42:47).EQ.'GB2IX1') THEN
READ(CHEAD(82:162),'(8X,3I10,2X,A40)',IOSTAT=IOS) NSKP,NLEN,NNUM
IF(IOS.EQ.0) THEN
ALLOCATE(CBUF(NLEN),STAT=ISTAT) ! ALLOCATE SPACE FOR CBUF
IF (ISTAT.NE.0) THEN
IRET=2
RETURN
ENDIF
IRET=0
CALL BAREAD
(LUGI,NSKP,NLEN,LBUF,CBUF)
IF(LBUF.NE.NLEN) IRET=3
ENDIF
ENDIF
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
RETURN
END