| 1 | C----------------------------------------------------------------------- |
|---|
| 2 | SUBROUTINE GETG2I(LUGI,CBUF,NLEN,NNUM,IRET) |
|---|
| 3 | C$$$ SUBPROGRAM DOCUMENTATION BLOCK |
|---|
| 4 | C |
|---|
| 5 | C SUBPROGRAM: GETG2I READS A GRIB2 INDEX FILE |
|---|
| 6 | C PRGMMR: IREDELL ORG: W/NMC23 DATE: 95-10-31 |
|---|
| 7 | C |
|---|
| 8 | C ABSTRACT: READ A GRIB2 INDEX FILE AND RETURN ITS CONTENTS. |
|---|
| 9 | C VERSION 1 OF THE INDEX FILE HAS THE FOLLOWING FORMAT: |
|---|
| 10 | C 81-BYTE S.LORD HEADER WITH 'GB2IX1' IN COLUMNS 42-47 FOLLOWED BY |
|---|
| 11 | C 81-BYTE HEADER WITH NUMBER OF BYTES TO SKIP BEFORE INDEX RECORDS, |
|---|
| 12 | C TOTAL LENGTH IN BYTES OF THE INDEX RECORDS, NUMBER OF INDEX RECORDS, |
|---|
| 13 | C AND GRIB FILE BASENAME WRITTEN IN FORMAT ('IX1FORM:',3I10,2X,A40). |
|---|
| 14 | C EACH FOLLOWING INDEX RECORD CORRESPONDS TO A GRIB MESSAGE |
|---|
| 15 | C AND HAS THE INTERNAL FORMAT: |
|---|
| 16 | C BYTE 001 - 004: LENGTH OF INDEX RECORD |
|---|
| 17 | C BYTE 005 - 008: BYTES TO SKIP IN DATA FILE BEFORE GRIB MESSAGE |
|---|
| 18 | C BYTE 009 - 012: BYTES TO SKIP IN MESSAGE BEFORE LUS (LOCAL USE) |
|---|
| 19 | C SET = 0, IF NO LOCAL USE SECTION IN GRIB2 MESSAGE. |
|---|
| 20 | C BYTE 013 - 016: BYTES TO SKIP IN MESSAGE BEFORE GDS |
|---|
| 21 | C BYTE 017 - 020: BYTES TO SKIP IN MESSAGE BEFORE PDS |
|---|
| 22 | C BYTE 021 - 024: BYTES TO SKIP IN MESSAGE BEFORE DRS |
|---|
| 23 | C BYTE 025 - 028: BYTES TO SKIP IN MESSAGE BEFORE BMS |
|---|
| 24 | C BYTE 029 - 032: BYTES TO SKIP IN MESSAGE BEFORE DATA SECTION |
|---|
| 25 | C BYTE 033 - 040: BYTES TOTAL IN THE MESSAGE |
|---|
| 26 | C BYTE 041 - 041: GRIB VERSION NUMBER ( CURRENTLY 2 ) |
|---|
| 27 | C BYTE 042 - 042: MESSAGE DISCIPLINE |
|---|
| 28 | C BYTE 043 - 044: FIELD NUMBER WITHIN GRIB2 MESSAGE |
|---|
| 29 | C BYTE 045 - II: IDENTIFICATION SECTION (IDS) |
|---|
| 30 | C BYTE II+1- JJ: GRID DEFINITION SECTION (GDS) |
|---|
| 31 | C BYTE JJ+1- KK: PRODUCT DEFINITION SECTION (PDS) |
|---|
| 32 | C BYTE KK+1- LL: THE DATA REPRESENTATION SECTION (DRS) |
|---|
| 33 | C BYTE LL+1-LL+6: FIRST 6 BYTES OF THE BIT MAP SECTION (BMS) |
|---|
| 34 | C |
|---|
| 35 | C PROGRAM HISTORY LOG: |
|---|
| 36 | C 95-10-31 IREDELL |
|---|
| 37 | C 96-10-31 IREDELL AUGMENTED OPTIONAL DEFINITIONS TO BYTE 320 |
|---|
| 38 | C 2002-01-03 GILBERT MODIFIED FROM GETGI TO WORK WITH GRIB2 |
|---|
| 39 | C |
|---|
| 40 | C USAGE: CALL GETG2I(LUGI,CBUF,NLEN,NNUM,IRET) |
|---|
| 41 | C INPUT ARGUMENTS: |
|---|
| 42 | C LUGI INTEGER UNIT OF THE UNBLOCKED GRIB INDEX FILE |
|---|
| 43 | C OUTPUT ARGUMENTS: |
|---|
| 44 | C CBUF CHARACTER*1 POINTER TO A BUFFER THAT CONTAINS INDEX RECORDS. |
|---|
| 45 | C USERS SHOULD FREE MEMORY THAT CBUF POINTS TO |
|---|
| 46 | C USING DEALLOCATE(CBUF) WHEN CBUF IS NO LONGER NEEDED. |
|---|
| 47 | C NLEN INTEGER TOTAL LENGTH OF ALL INDEX RECORDS |
|---|
| 48 | C NNUM INTEGER NUMBER OF INDEX RECORDS |
|---|
| 49 | C IRET INTEGER RETURN CODE |
|---|
| 50 | C 0 ALL OK |
|---|
| 51 | C 2 NOT ENOUGH MEMORY TO HOLD INDEX BUFFER |
|---|
| 52 | C 3 ERROR READING INDEX FILE BUFFER |
|---|
| 53 | C 4 ERROR READING INDEX FILE HEADER |
|---|
| 54 | C |
|---|
| 55 | C SUBPROGRAMS CALLED: |
|---|
| 56 | C BAREAD BYTE-ADDRESSABLE READ |
|---|
| 57 | C |
|---|
| 58 | C REMARKS: SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. |
|---|
| 59 | C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR. |
|---|
| 60 | C |
|---|
| 61 | C ATTRIBUTES: |
|---|
| 62 | C LANGUAGE: FORTRAN 90 |
|---|
| 63 | C |
|---|
| 64 | C$$$ |
|---|
| 65 | CHARACTER(LEN=1),POINTER,DIMENSION(:) :: CBUF |
|---|
| 66 | INTEGER,INTENT(IN) :: LUGI |
|---|
| 67 | INTEGER,INTENT(OUT) :: NLEN,NNUM,IRET |
|---|
| 68 | CHARACTER CHEAD*162 |
|---|
| 69 | C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
|---|
| 70 | IF (ASSOCIATED(CBUF)) NULLIFY(CBUF) |
|---|
| 71 | C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
|---|
| 72 | NLEN=0 |
|---|
| 73 | NNUM=0 |
|---|
| 74 | IRET=4 |
|---|
| 75 | CALL BAREAD(LUGI,0,162,LHEAD,CHEAD) |
|---|
| 76 | IF(LHEAD.EQ.162.AND.CHEAD(42:47).EQ.'GB2IX1') THEN |
|---|
| 77 | READ(CHEAD(82:162),'(8X,3I10,2X,A40)',IOSTAT=IOS) NSKP,NLEN,NNUM |
|---|
| 78 | IF(IOS.EQ.0) THEN |
|---|
| 79 | |
|---|
| 80 | ALLOCATE(CBUF(NLEN),STAT=ISTAT) ! ALLOCATE SPACE FOR CBUF |
|---|
| 81 | IF (ISTAT.NE.0) THEN |
|---|
| 82 | IRET=2 |
|---|
| 83 | RETURN |
|---|
| 84 | ENDIF |
|---|
| 85 | IRET=0 |
|---|
| 86 | CALL BAREAD(LUGI,NSKP,NLEN,LBUF,CBUF) |
|---|
| 87 | IF(LBUF.NE.NLEN) IRET=3 |
|---|
| 88 | |
|---|
| 89 | ENDIF |
|---|
| 90 | ENDIF |
|---|
| 91 | C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
|---|
| 92 | RETURN |
|---|
| 93 | END |
|---|
