getg2i.f

Go to the documentation of this file.

C>    @file
C>    @brief This subroutine read a GRIB2 index file and return its content.
C>    @author Mark Iredell @date 1995-10-31
C>
 
C>    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>    - 1995-10-31 Mark Iredell
C>    - 1996-10-31 Mark Iredell AUGMENTED OPTIONAL DEFINITIONS TO BYTE 320
C>    - 2002-01-03 Stephen Gilbert MODIFIED FROM GETGI TO WORK WITH GRIB2
C>
C>    @param[in] LUGI INTEGER UNIT OF THE UNBLOCKED GRIB INDEX FILE
C>    @param[out] CBUF CHARACTER*1 POINTER TO A BUFFER THAT CONTAINS INDEX
C>    RECORDS. USERS SHOULD FREE MEMORY THAT CBUF POINTS TO, USING
C>    DEALLOCATE(CBUF) WHEN CBUF IS NO LONGER NEEDED.
C>    @param[out] NLEN INTEGER TOTAL LENGTH OF ALL INDEX RECORDS
C>    @param[out] NNUM INTEGER NUMBER OF INDEX RECORDS
C>    @param[out] 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>    @note SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT.
C>    DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR.
C>
C>    @author Mark Iredell @date 2000-05-26
C>
 
      SUBROUTINE getg2i(LUGI,CBUF,NLEN,NNUM,IRET)
 
      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