ungrib/src/ngl/w3/ixgb.f

   1 C-----------------------------------------------------------------------
   2       SUBROUTINE IXGB(LUGB,LSKIP,LGRIB,NLEN,NNUM,MLEN,CBUF)
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM: IXGB           MAKE INDEX RECORD
   6 C   PRGMMR: IREDELL          ORG: W/NMC23     DATE: 95-10-31
   7 C
   8 C ABSTRACT: THIS SUBPROGRAM MAKES ONE INDEX RECORD.
   9 C       BYTE 001-004: BYTES TO SKIP IN DATA FILE BEFORE GRIB MESSAGE
  10 C       BYTE 005-008: BYTES TO SKIP IN MESSAGE BEFORE PDS
  11 C       BYTE 009-012: BYTES TO SKIP IN MESSAGE BEFORE GDS (0 IF NO GDS)
  12 C       BYTE 013-016: BYTES TO SKIP IN MESSAGE BEFORE BMS (0 IF NO BMS)
  13 C       BYTE 017-020: BYTES TO SKIP IN MESSAGE BEFORE BDS
  14 C       BYTE 021-024: BYTES TOTAL IN THE MESSAGE
  15 C       BYTE 025-025: GRIB VERSION NUMBER
  16 C       BYTE 026-053: PRODUCT DEFINITION SECTION (PDS)
  17 C       BYTE 054-095: GRID DEFINITION SECTION (GDS) (OR NULLS)
  18 C       BYTE 096-101: FIRST PART OF THE BIT MAP SECTION (BMS) (OR NULLS)
  19 C       BYTE 102-112: FIRST PART OF THE BINARY DATA SECTION (BDS)
  20 C       BYTE 113-172: (OPTIONAL) BYTES 41-100 OF THE PDS
  21 C       BYTE 173-184: (OPTIONAL) BYTES 29-40 OF THE PDS
  22 C       BYTE 185-320: (OPTIONAL) BYTES 43-178 OF THE GDS
  23 C
  24 C PROGRAM HISTORY LOG:
  25 C   95-10-31  IREDELL
  26 C   96-10-31  IREDELL   AUGMENTED OPTIONAL DEFINITIONS TO BYTE 320
  27 C
  28 C USAGE:    CALL WRGI1R(LUGB,LSKIP,LGRIB,LUGI)
  29 C   INPUT ARGUMENTS:
  30 C     LUGB         INTEGER LOGICAL UNIT OF INPUT GRIB FILE
  31 C     LSKIP        INTEGER NUMBER OF BYTES TO SKIP BEFORE GRIB MESSAGE
  32 C     LGRIB        INTEGER NUMBER OF BYTES IN GRIB MESSAGE
  33 C     NLEN         INTEGER LENGTH OF EACH INDEX RECORD IN BYTES
  34 C     NNUM         INTEGER INDEX RECORD NUMBER TO MAKE
  35 C   OUTPUT ARGUMENTS:
  36 C     MLEN         INTEGER ACTUAL VALID LENGTH OF INDEX RECORD
  37 C     CBUF         CHARACTER*1 (MBUF) BUFFER TO RECEIVE INDEX DATA
  38 C
  39 C SUBPROGRAMS CALLED:
  40 C   GBYTE        GET INTEGER DATA FROM BYTES
  41 C   SBYTE        STORE INTEGER DATA IN BYTES
  42 C   BAREAD       BYTE-ADDRESSABLE READ
  43 C
  44 C ATTRIBUTES:
  45 C   LANGUAGE: CRAY FORTRAN
  46 C
  47 C$$$
  48       CHARACTER CBUF(*)
  49       PARAMETER(LINDEX=112,MINDEX=320)
  50       PARAMETER(IXSKP=0,IXSPD=4,IXSGD=8,IXSBM=12,IXSBD=16,IXLEN=20,
  51      &          IXVER=24,IXPDS=25,IXGDS=53,IXBMS=95,IXBDS=101,
  52      &          IXPDX=112,IXPDW=172,IXGDX=184)
  53       PARAMETER(MXSKP=4,MXSPD=4,MXSGD=4,MXSBM=4,MXSBD=4,MXLEN=4,
  54      &          MXVER=1,MXPDS=28,MXGDS=42,MXBMS=6,MXBDS=11,
  55      &          MXPDX=60,MXPDW=12,MXGDX=136)
  56       CHARACTER CBREAD(MINDEX),CINDEX(MINDEX)
  57 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  58 C  INITIALIZE INDEX RECORD AND READ GRIB MESSAGE
  59       MLEN=LINDEX
  60       CINDEX=CHAR(0)
  61       CALL SBYTE(CINDEX,LSKIP,8*IXSKP,8*MXSKP)
  62       CALL SBYTE(CINDEX,LGRIB,8*IXLEN,8*MXLEN)
  63 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  64 C  PUT PDS IN INDEX RECORD
  65       ISKPDS=8
  66       IBSKIP=LSKIP
  67       IBREAD=ISKPDS+MXPDS
  68       CALL BAREAD(LUGB,IBSKIP,IBREAD,LBREAD,CBREAD)
  69       IF(LBREAD.NE.IBREAD) RETURN
  70       CINDEX(IXVER+1)=CBREAD(8)
  71       CALL SBYTE(CINDEX,ISKPDS,8*IXSPD,8*MXSPD)
  72       CALL GBYTE(CBREAD,LENPDS,8*ISKPDS,8*3)
  73       CALL GBYTE(CBREAD,INCGDS,8*ISKPDS+8*7+0,1)
  74       CALL GBYTE(CBREAD,INCBMS,8*ISKPDS+8*7+1,1)
  75       ILNPDS=MIN(LENPDS,MXPDS)
  76       CINDEX(IXPDS+1:IXPDS+ILNPDS)=CBREAD(ISKPDS+1:ISKPDS+ILNPDS)
  77       ISKTOT=ISKPDS+LENPDS
  78 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  79 C  PUT PDS EXTENSION IN INDEX RECORD
  80       IF(LENPDS.GT.MXPDS) THEN
  81         ISKPDW=ISKPDS+MXPDS
  82         ILNPDW=MIN(LENPDS-MXPDS,MXPDW)
  83         IBSKIP=LSKIP+ISKPDW
  84         IBREAD=ILNPDW
  85         CALL BAREAD(LUGB,IBSKIP,IBREAD,LBREAD,CBREAD)
  86         IF(LBREAD.NE.IBREAD) RETURN
  87         CINDEX(IXPDW+1:IXPDW+ILNPDW)=CBREAD(1:ILNPDW)
  88         ISKPDX=ISKPDS+(MXPDS+MXPDW)
  89         ILNPDX=MIN(LENPDS-(MXPDS+MXPDW),MXPDX)
  90         IBSKIP=LSKIP+ISKPDX
  91         IBREAD=ILNPDX
  92         CALL BAREAD(LUGB,IBSKIP,IBREAD,LBREAD,CBREAD)
  93         IF(LBREAD.NE.IBREAD) RETURN
  94         CINDEX(IXPDX+1:IXPDX+ILNPDX)=CBREAD(1:ILNPDX)
  95         MLEN=MAX(MLEN,IXPDW+ILNPDW,IXPDX+ILNPDX)
  96       ENDIF
  97 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  98 C  PUT GDS IN INDEX RECORD
  99       IF(INCGDS.NE.0) THEN
 100         ISKGDS=ISKTOT
 101         IBSKIP=LSKIP+ISKGDS
 102         IBREAD=MXGDS
 103         CALL BAREAD(LUGB,IBSKIP,IBREAD,LBREAD,CBREAD)
 104         IF(LBREAD.NE.IBREAD) RETURN
 105         CALL SBYTE(CINDEX,ISKGDS,8*IXSGD,8*MXSGD)
 106         CALL GBYTE(CBREAD,LENGDS,0,8*3)
 107         ILNGDS=MIN(LENGDS,MXGDS)
 108         CINDEX(IXGDS+1:IXGDS+ILNGDS)=CBREAD(1:ILNGDS)
 109         ISKTOT=ISKGDS+LENGDS
 110         IF(LENGDS.GT.MXGDS) THEN
 111           ISKGDX=ISKGDS+MXGDS
 112           ILNGDX=MIN(LENGDS-MXGDS,MXGDX)
 113           IBSKIP=LSKIP+ISKGDX
 114           IBREAD=ILNGDX
 115           CALL BAREAD(LUGB,IBSKIP,IBREAD,LBREAD,CBREAD)
 116           IF(LBREAD.NE.IBREAD) RETURN
 117           CINDEX(IXGDX+1:IXGDX+ILNGDX)=CBREAD(1:ILNGDX)
 118           MLEN=MAX(MLEN,IXGDX+ILNGDX)
 119         ENDIF
 120       ENDIF
 121 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 122 C  PUT BMS IN INDEX RECORD
 123       IF(INCBMS.NE.0) THEN
 124         ISKBMS=ISKTOT
 125         IBSKIP=LSKIP+ISKBMS
 126         IBREAD=MXBMS
 127         CALL BAREAD(LUGB,IBSKIP,IBREAD,LBREAD,CBREAD)
 128         IF(LBREAD.NE.IBREAD) RETURN
 129         CALL SBYTE(CINDEX,ISKBMS,8*IXSBM,8*MXSBM)
 130         CALL GBYTE(CBREAD,LENBMS,0,8*3)
 131         ILNBMS=MIN(LENBMS,MXBMS)
 132         CINDEX(IXBMS+1:IXBMS+ILNBMS)=CBREAD(1:ILNBMS)
 133         ISKTOT=ISKBMS+LENBMS
 134       ENDIF
 135 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 136 C  PUT BDS IN INDEX RECORD
 137       ISKBDS=ISKTOT
 138       IBSKIP=LSKIP+ISKBDS
 139       IBREAD=MXBDS
 140       CALL BAREAD(LUGB,IBSKIP,IBREAD,LBREAD,CBREAD)
 141       IF(LBREAD.NE.IBREAD) RETURN
 142       CALL SBYTE(CINDEX,ISKBDS,8*IXSBD,8*MXSBD)
 143       CALL GBYTE(CBREAD,LENBDS,0,8*3)
 144       ILNBDS=MIN(LENBDS,MXBDS)
 145       CINDEX(IXBDS+1:IXBDS+ILNBDS)=CBREAD(1:ILNBDS)
 146 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 147 C  STORE INDEX RECORD
 148       MLEN=MIN(MLEN,NLEN)
 149       NSKIP=NLEN*(NNUM-1)
 150       CBUF(NSKIP+1:NSKIP+MLEN)=CINDEX(1:MLEN)
 151       CBUF(NSKIP+MLEN+1:NSKIP+NLEN)=CHAR(0)
 152 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 153       RETURN
 154       END