ungrib/src/ngl/w3/getgir.f

   1 C-----------------------------------------------------------------------
   2       SUBROUTINE GETGIR(LUGB,MSK1,MSK2,MNUM,MBUF,CBUF,NLEN,NNUM,IRET)
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM: GETGIR         READS A GRIB INDEX FILE
   6 C   PRGMMR: IREDELL          ORG: W/NMC23     DATE: 95-10-31
   7 C
   8 C ABSTRACT: READ A GRIB FILE AND RETURN ITS INDEX CONTENTS.
   9 C   THE INDEX BUFFER RETURNED CONTAINS INDEX RECORDS WITH THE INTERNAL FORMAT:
  10 C       BYTE 001-004: BYTES TO SKIP IN DATA FILE BEFORE GRIB MESSAGE
  11 C       BYTE 005-008: BYTES TO SKIP IN MESSAGE BEFORE PDS
  12 C       BYTE 009-012: BYTES TO SKIP IN MESSAGE BEFORE GDS (0 IF NO GDS)
  13 C       BYTE 013-016: BYTES TO SKIP IN MESSAGE BEFORE BMS (0 IF NO BMS)
  14 C       BYTE 017-020: BYTES TO SKIP IN MESSAGE BEFORE BDS
  15 C       BYTE 021-024: BYTES TOTAL IN THE MESSAGE
  16 C       BYTE 025-025: GRIB VERSION NUMBER
  17 C       BYTE 026-053: PRODUCT DEFINITION SECTION (PDS)
  18 C       BYTE 054-095: GRID DEFINITION SECTION (GDS) (OR NULLS)
  19 C       BYTE 096-101: FIRST PART OF THE BIT MAP SECTION (BMS) (OR NULLS)
  20 C       BYTE 102-112: FIRST PART OF THE BINARY DATA SECTION (BDS)
  21 C       BYTE 113-172: (OPTIONAL) BYTES 41-100 OF THE PDS
  22 C       BYTE 173-184: (OPTIONAL) BYTES 29-40 OF THE PDS
  23 C       BYTE 185-320: (OPTIONAL) BYTES 43-178 OF THE GDS
  24 C
  25 C PROGRAM HISTORY LOG:
  26 C   95-10-31  IREDELL
  27 C   96-10-31  IREDELL   AUGMENTED OPTIONAL DEFINITIONS TO BYTE 320
  28 C
  29 C USAGE:    CALL GETGIR(LUGB,MSK1,MSK2,MNUM,MBUF,CBUF,NLEN,NNUM,IRET)
  30 C   INPUT ARGUMENTS:
  31 C     LUGB         INTEGER UNIT OF THE UNBLOCKED GRIB FILE
  32 C     MSK1         INTEGER NUMBER OF BYTES TO SEARCH FOR FIRST MESSAGE
  33 C     MSK2         INTEGER NUMBER OF BYTES TO SEARCH FOR OTHER MESSAGES
  34 C     MNUM         INTEGER NUMBER OF INDEX RECORDS TO SKIP (USUALLY 0)
  35 C     MBUF         INTEGER LENGTH OF CBUF IN BYTES
  36 C   OUTPUT ARGUMENTS:
  37 C     CBUF         CHARACTER*1 (MBUF) BUFFER TO RECEIVE INDEX DATA
  38 C     NLEN         INTEGER LENGTH OF EACH INDEX RECORD IN BYTES
  39 C     NNUM         INTEGER NUMBER OF INDEX RECORDS
  40 C                  (=0 IF NO GRIB MESSAGES ARE FOUND)
  41 C     IRET         INTEGER RETURN CODE
  42 C                    0      ALL OK
  43 C                    1      CBUF TOO SMALL TO HOLD INDEX DATA
  44 C
  45 C SUBPROGRAMS CALLED:
  46 C   SKGB           SEEK NEXT GRIB MESSAGE
  47 C   IXGB           MAKE INDEX RECORD
  48 C
  49 C REMARKS: SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT.
  50 C   DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR.
  51 C
  52 C ATTRIBUTES:
  53 C   LANGUAGE: FORTRAN 77
  54 C   MACHINE:  CRAY, WORKSTATIONS
  55 C
  56 C$$$
  57       CHARACTER CBUF(MBUF)
  58       PARAMETER(MINDEX=320)
  59 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  60 C  SEARCH FOR FIRST GRIB MESSAGE
  61       ISEEK=0
  62       CALL SKGB(LUGB,ISEEK,MSK1,LSKIP,LGRIB)
  63       IF(LGRIB.GT.0.AND.MINDEX.LE.MBUF) THEN
  64         CALL IXGB(LUGB,LSKIP,LGRIB,MINDEX,1,NLEN,CBUF)
  65       ELSE
  66         NLEN=MINDEX
  67       ENDIF
  68       DO M=1,MNUM
  69         IF(LGRIB.GT.0) THEN
  70           ISEEK=LSKIP+LGRIB
  71           CALL SKGB(LUGB,ISEEK,MSK2,LSKIP,LGRIB)
  72         ENDIF
  73       ENDDO
  74 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  75 C  MAKE AN INDEX RECORD FOR EVERY GRIB RECORD FOUND
  76       NNUM=0
  77       IRET=0
  78       DOWHILE(IRET.EQ.0.AND.LGRIB.GT.0)
  79         IF(NLEN*(NNUM+1).LE.MBUF) THEN
  80           NNUM=NNUM+1
  81           CALL IXGB(LUGB,LSKIP,LGRIB,NLEN,NNUM,MLEN,CBUF)
  82           ISEEK=LSKIP+LGRIB
  83           CALL SKGB(LUGB,ISEEK,MSK2,LSKIP,LGRIB)
  84         ELSE
  85           IRET=1
  86         ENDIF
  87       ENDDO
  88 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  89       RETURN
  90       END