ungrib/src/ngl/g2/getg2i.f

   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