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