ungrib/src/ngl/w3/getgi.f

   1 C-----------------------------------------------------------------------
   2       SUBROUTINE GETGI(LUGI,MNUM,MBUF,CBUF,NLEN,NNUM,IRET)
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM: GETGI          READS A GRIB INDEX FILE
   6 C   PRGMMR: IREDELL          ORG: W/NMC23     DATE: 95-10-31
   7 C
   8 C ABSTRACT: READ A GRIB 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 'GB1IX1' IN COLUMNS 42-47 FOLLOWED BY
  11 C     81-BYTE HEADER WITH NUMBER OF BYTES TO SKIP BEFORE INDEX RECORDS,
  12 C     NUMBER OF BYTES IN EACH INDEX RECORD, 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: BYTES TO SKIP IN DATA FILE BEFORE GRIB MESSAGE
  17 C       BYTE 005-008: BYTES TO SKIP IN MESSAGE BEFORE PDS
  18 C       BYTE 009-012: BYTES TO SKIP IN MESSAGE BEFORE GDS (0 IF NO GDS)
  19 C       BYTE 013-016: BYTES TO SKIP IN MESSAGE BEFORE BMS (0 IF NO BMS)
  20 C       BYTE 017-020: BYTES TO SKIP IN MESSAGE BEFORE BDS
  21 C       BYTE 021-024: BYTES TOTAL IN THE MESSAGE
  22 C       BYTE 025-025: GRIB VERSION NUMBER
  23 C       BYTE 026-053: PRODUCT DEFINITION SECTION (PDS)
  24 C       BYTE 054-095: GRID DEFINITION SECTION (GDS) (OR NULLS)
  25 C       BYTE 096-101: FIRST PART OF THE BIT MAP SECTION (BMS) (OR NULLS)
  26 C       BYTE 102-112: FIRST PART OF THE BINARY DATA SECTION (BDS)
  27 C       BYTE 113-172: (OPTIONAL) BYTES 41-100 OF THE PDS
  28 C       BYTE 173-184: (OPTIONAL) BYTES 29-40 OF THE PDS
  29 C       BYTE 185-320: (OPTIONAL) BYTES 43-178 OF THE GDS
  30 C
  31 C PROGRAM HISTORY LOG:
  32 C   95-10-31  IREDELL
  33 C   96-10-31  IREDELL   AUGMENTED OPTIONAL DEFINITIONS TO BYTE 320
  34 C
  35 C USAGE:    CALL GETGI(LUGI,MNUM,MBUF,CBUF,NLEN,NNUM,IRET)
  36 C   INPUT ARGUMENTS:
  37 C     LUGI         INTEGER UNIT OF THE UNBLOCKED GRIB INDEX FILE
  38 C     MNUM         INTEGER NUMBER OF INDEX RECORDS TO SKIP (USUALLY 0)
  39 C     MBUF         INTEGER LENGTH OF CBUF IN BYTES
  40 C   OUTPUT ARGUMENTS:
  41 C     CBUF         CHARACTER*1 (MBUF) BUFFER TO RECEIVE INDEX DATA
  42 C     NLEN         INTEGER LENGTH OF EACH INDEX RECORD IN BYTES
  43 C     NNUM         INTEGER NUMBER OF INDEX RECORDS
  44 C     IRET         INTEGER RETURN CODE
  45 C                    0      ALL OK
  46 C                    1      CBUF TOO SMALL TO HOLD INDEX BUFFER
  47 C                    2      ERROR READING INDEX FILE BUFFER
  48 C                    3      ERROR READING INDEX FILE HEADER
  49 C
  50 C SUBPROGRAMS CALLED:
  51 C   BAREAD         BYTE-ADDRESSABLE READ
  52 C
  53 C REMARKS: SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT.
  54 C   DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR.
  55 C
  56 C ATTRIBUTES:
  57 C   LANGUAGE: FORTRAN 77
  58 C   MACHINE:  CRAY, WORKSTATIONS
  59 C
  60 C$$$
  61       CHARACTER CBUF(MBUF)
  62       CHARACTER CHEAD*162
  63 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  64       NLEN=0
  65       NNUM=0
  66       IRET=3
  67       CALL BAREAD(LUGI,0,162,LHEAD,CHEAD)
  68       IF(LHEAD.EQ.162.AND.CHEAD(42:47).EQ.'GB1IX1') THEN
  69         READ(CHEAD(82:162),'(8X,3I10,2X,A40)',IOSTAT=IOS) NSKP,NLEN,NNUM
  70         IF(IOS.EQ.0) THEN
  71           NSKP=NSKP+MNUM*NLEN
  72           NNUM=NNUM-MNUM
  73           NBUF=NNUM*NLEN
  74           IRET=0
  75           IF(NBUF.GT.MBUF) THEN
  76             NNUM=MBUF/NLEN
  77             NBUF=NNUM*NLEN
  78             IRET=1
  79           ENDIF
  80           IF(NBUF.GT.0) THEN
  81             CALL BAREAD(LUGI,NSKP,NBUF,LBUF,CBUF)
  82             IF(LBUF.NE.NBUF) IRET=2
  83           ENDIF
  84         ENDIF
  85       ENDIF
  86 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  87       RETURN
  88       END