C-----------------------------------------------------------------------
SUBROUTINE GETG2IR(LUGB,MSK1,MSK2,MNUM,CBUF,NLEN,NNUM,NMESS,IRET) 2,6
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: GETG2IR CREATES AN INDEX OF A GRIB2 FILE
C PRGMMR: GILBERT ORG: W/NP11 DATE: 2002-01-02
C
C ABSTRACT: READ A GRIB FILE AND RETURN ITS INDEX CONTENTS.
C THE INDEX BUFFER RETURNED CONTAINS INDEX RECORDS WITH 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-02 GILBERT MODIFIED FROM GETGIR TO CREATE GRIB2 INDEXES
C
C USAGE: CALL GETG2IR(LUGB,MSK1,MSK2,MNUM,CBUF,NLEN,NNUM,NMESS,IRET)
C INPUT ARGUMENTS:
C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB FILE
C MSK1 INTEGER NUMBER OF BYTES TO SEARCH FOR FIRST MESSAGE
C MSK2 INTEGER NUMBER OF BYTES TO SEARCH FOR OTHER MESSAGES
C MNUM INTEGER NUMBER OF GRIB MESSAGES TO SKIP (USUALLY 0)
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 INDEX RECORD BUFFER IN BYTES
C NNUM INTEGER NUMBER OF INDEX RECORDS
C (=0 IF NO GRIB MESSAGES ARE FOUND)
C NMESS LAST GRIB MESSAGE IN FILE SUCCESSFULLY PROCESSED
C IRET INTEGER RETURN CODE
C 0 ALL OK
C 1 NOT ENOUGH MEMORY AVAILABLE TO HOLD FULL INDEX
C BUFFER
C 2 NOT ENOUGH MEMORY TO ALLOCATE INITIAL INDEX BUFFER
C
C SUBPROGRAMS CALLED:
C SKGB SEEK NEXT GRIB MESSAGE
C IXGB2 MAKE INDEX RECORD
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$$$
USE RE_ALLOC
! NEEDED FOR SUBROUTINE REALLOC
PARAMETER(INIT=50000,NEXT=10000)
CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF
INTEGER,INTENT(IN) :: LUGB,MSK1,MSK2,MNUM
INTEGER,INTENT(OUT) :: NLEN,NNUM,NMESS,IRET
CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUFTMP
INTERFACE ! REQUIRED FOR CBUF POINTER
SUBROUTINE IXGB2(LUGB,LSKIP,LGRIB,CBUF,NUMFLD,MLEN,IRET)
INTEGER,INTENT(IN) :: LUGB,LSKIP,LGRIB
CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF
INTEGER,INTENT(OUT) :: NUMFLD,MLEN,IRET
END SUBROUTINE IXGB2
END INTERFACE
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C INITIALIZE
IRET=0
IF (ASSOCIATED(CBUF)) NULLIFY(CBUF)
MBUF=INIT
ALLOCATE(CBUF(MBUF),STAT=ISTAT) ! ALLOCATE INITIAL SPACE FOR CBUF
IF (ISTAT.NE.0) THEN
IRET=2
RETURN
ENDIF
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C SEARCH FOR FIRST GRIB MESSAGE
ISEEK=0
CALL SKGB
(LUGB,ISEEK,MSK1,LSKIP,LGRIB)
DO M=1,MNUM
IF(LGRIB.GT.0) THEN
ISEEK=LSKIP+LGRIB
CALL SKGB
(LUGB,ISEEK,MSK2,LSKIP,LGRIB)
ENDIF
ENDDO
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C GET INDEX RECORDS FOR EVERY GRIB MESSAGE FOUND
NLEN=0
NNUM=0
NMESS=MNUM
DOWHILE(IRET.EQ.0.AND.LGRIB.GT.0)
CALL IXGB2
(LUGB,LSKIP,LGRIB,CBUFTMP,NUMFLD,NBYTES,IRET1)
IF (IRET1.NE.0) PRINT *,' SAGT ',NUMFLD,NBYTES,IRET1
IF((NBYTES+NLEN).GT.MBUF) THEN ! ALLOCATE MORE SPACE, IF
! NECESSARY
NEWSIZE=MAX(MBUF+NEXT,MBUF+NBYTES)
CALL REALLOC
(CBUF,NLEN,NEWSIZE,ISTAT)
IF ( ISTAT .NE. 0 ) THEN
IRET=1
RETURN
ENDIF
MBUF=NEWSIZE
ENDIF
!
! IF INDEX RECORDS WERE RETURNED IN CBUFTMP FROM IXGB2,
! COPY CBUFTMP INTO CBUF, THEN DEALLOCATE CBUFTMP WHEN DONE
!
IF ( ASSOCIATED(CBUFTMP) ) THEN
CBUF(NLEN+1:NLEN+NBYTES)=CBUFTMP(1:NBYTES)
DEALLOCATE(CBUFTMP,STAT=ISTAT)
IF (ISTAT.NE.0) THEN
PRINT *,' deallocating cbuftmp ... ',istat
stop 99
ENDIF
NULLIFY(CBUFTMP)
NNUM=NNUM+NUMFLD
NLEN=NLEN+NBYTES
NMESS=NMESS+1
ENDIF
! LOOK FOR NEXT GRIB MESSAGE
ISEEK=LSKIP+LGRIB
CALL SKGB
(LUGB,ISEEK,MSK2,LSKIP,LGRIB)
ENDDO
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
RETURN
END