source: lmdz_wrf/WRFV3/external/io_grib2/g2lib/getg2i.F @ 1

C-----------------------------------------------------------------------
      SUBROUTINE GETG2I(LUGI,CBUF,NLEN,NNUM,IRET)
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