ixgb.f

Go to the documentation of this file.

C> @file
C> @brief This subprogram makes one index record.
C> @author Mark iredell @date 1995-10-31
 
C> Byte 001-004: Bytes to skip in data file before grib message.
C> Byte 005-008: Bytes to skip in message before pds.
C> Byte 009-012: Bytes to skip in message before gds (0 if no gds).
C> Byte 013-016: Bytes to skip in message before bms (0 if no bms).
C> Byte 017-020: Bytes to skip in message before bds.
C> Byte 021-024: Bytes total in the message.
C> Byte 025-025: Grib version number.
C> Byte 026-053: Product definition section (pds).
C> Byte 054-095: Grid definition section (gds) (or nulls).
C> Byte 096-101: First part of the bit map section (bms) (or nulls).
C> Byte 102-112: First part of the binary data section (bds).
C> Byte 113-172: (optional) bytes 41-100 of the pds.
C> Byte 173-184: (optional) bytes 29-40 of the pds.
C> Byte 185-320: (optional) bytes 43-178 of the gds.
C>
C> Program history log:
C> - Mark iredell 1995-10-31
C> - Mark iredell 1996-10-31 Augmented optional definitions to byte 320.
C> - Mark iredell 2001-06-05 Apply linux port by ebisuzaki.
C>
C> @param[in] LUGB Integer logical unit of input grib file.
C> @param[in] LSKIP Integer number of bytes to skip before grib message.
C> @param[in] LGRIB Integer number of bytes in grib message.
C> @param[in] NLEN Integer length of each index record in bytes.
C> @param[in] NNUM Integer index record number to make.
C> @param[out] MLEN Integer actual valid length of index record.
C> @param[out] CBUF Character*1 (mbuf) buffer to receive index data.
C>
C> @author Mark iredell @date 1995-10-31
C-----------------------------------------------------------------------
      SUBROUTINE ixgb(LUGB,LSKIP,LGRIB,NLEN,NNUM,MLEN,CBUF)
      CHARACTER CBUF(*)
      parameter(lindex=112,mindex=320)
      parameter(ixskp=0,ixspd=4,ixsgd=8,ixsbm=12,ixsbd=16,ixlen=20,
     &          ixver=24,ixpds=25,ixgds=53,ixbms=95,ixbds=101,
     &          ixpdx=112,ixpdw=172,ixgdx=184)
      parameter(mxskp=4,mxspd=4,mxsgd=4,mxsbm=4,mxsbd=4,mxlen=4,
     &          mxver=1,mxpds=28,mxgds=42,mxbms=6,mxbds=11,
     &          mxpdx=60,mxpdw=12,mxgdx=136)
      CHARACTER CBREAD(MINDEX),CINDEX(MINDEX)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C  INITIALIZE INDEX RECORD AND READ GRIB MESSAGE
      mlen=lindex
      cindex=char(0)
      CALL sbytec(cindex,lskip,8*ixskp,8*mxskp)
      CALL sbytec(cindex,lgrib,8*ixlen,8*mxlen)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C  PUT PDS IN INDEX RECORD
      iskpds=8
      ibskip=lskip
      ibread=iskpds+mxpds
      CALL baread(lugb,ibskip,ibread,lbread,cbread)
      IF(lbread.NE.ibread) RETURN
      cindex(ixver+1)=cbread(8)
      CALL sbytec(cindex,iskpds,8*ixspd,8*mxspd)
      CALL gbytec(cbread,lenpds,8*iskpds,8*3)
      CALL gbytec(cbread,incgds,8*iskpds+8*7+0,1)
      CALL gbytec(cbread,incbms,8*iskpds+8*7+1,1)
      ilnpds=min(lenpds,mxpds)
      cindex(ixpds+1:ixpds+ilnpds)=cbread(iskpds+1:iskpds+ilnpds)
      isktot=iskpds+lenpds
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C  PUT PDS EXTENSION IN INDEX RECORD
      IF(lenpds.GT.mxpds) THEN
        iskpdw=iskpds+mxpds
        ilnpdw=min(lenpds-mxpds,mxpdw)
        ibskip=lskip+iskpdw
        ibread=ilnpdw
        CALL baread(lugb,ibskip,ibread,lbread,cbread)
        IF(lbread.NE.ibread) RETURN
        cindex(ixpdw+1:ixpdw+ilnpdw)=cbread(1:ilnpdw)
        iskpdx=iskpds+(mxpds+mxpdw)
        ilnpdx=min(lenpds-(mxpds+mxpdw),mxpdx)
        ibskip=lskip+iskpdx
        ibread=ilnpdx
        CALL baread(lugb,ibskip,ibread,lbread,cbread)
        IF(lbread.NE.ibread) RETURN
        cindex(ixpdx+1:ixpdx+ilnpdx)=cbread(1:ilnpdx)
        mlen=max(mlen,ixpdw+ilnpdw,ixpdx+ilnpdx)
      ENDIF
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C  PUT GDS IN INDEX RECORD
      IF(incgds.NE.0) THEN
        iskgds=isktot
        ibskip=lskip+iskgds
        ibread=mxgds
        CALL baread(lugb,ibskip,ibread,lbread,cbread)
        IF(lbread.NE.ibread) RETURN
        CALL sbytec(cindex,iskgds,8*ixsgd,8*mxsgd)
        CALL gbytec(cbread,lengds,0,8*3)
        ilngds=min(lengds,mxgds)
        cindex(ixgds+1:ixgds+ilngds)=cbread(1:ilngds)
        isktot=iskgds+lengds
        IF(lengds.GT.mxgds) THEN
          iskgdx=iskgds+mxgds
          ilngdx=min(lengds-mxgds,mxgdx)
          ibskip=lskip+iskgdx
          ibread=ilngdx
          CALL baread(lugb,ibskip,ibread,lbread,cbread)
          IF(lbread.NE.ibread) RETURN
          cindex(ixgdx+1:ixgdx+ilngdx)=cbread(1:ilngdx)
          mlen=max(mlen,ixgdx+ilngdx)
        ENDIF
      ENDIF
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C  PUT BMS IN INDEX RECORD
      IF(incbms.NE.0) THEN
        iskbms=isktot
        ibskip=lskip+iskbms
        ibread=mxbms
        CALL baread(lugb,ibskip,ibread,lbread,cbread)
        IF(lbread.NE.ibread) RETURN
        CALL sbytec(cindex,iskbms,8*ixsbm,8*mxsbm)
        CALL gbytec(cbread,lenbms,0,8*3)
        ilnbms=min(lenbms,mxbms)
        cindex(ixbms+1:ixbms+ilnbms)=cbread(1:ilnbms)
        isktot=iskbms+lenbms
      ENDIF
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C  PUT BDS IN INDEX RECORD
      iskbds=isktot
      ibskip=lskip+iskbds
      ibread=mxbds
      CALL baread(lugb,ibskip,ibread,lbread,cbread)
      IF(lbread.NE.ibread) RETURN
      CALL sbytec(cindex,iskbds,8*ixsbd,8*mxsbd)
      CALL gbytec(cbread,lenbds,0,8*3)
      ilnbds=min(lenbds,mxbds)
      cindex(ixbds+1:ixbds+ilnbds)=cbread(1:ilnbds)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C  STORE INDEX RECORD
      mlen=min(mlen,nlen)
      nskip=nlen*(nnum-1)
      cbuf(nskip+1:nskip+mlen)=cindex(1:mlen)
      cbuf(nskip+mlen+1:nskip+nlen)=char(0)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      RETURN
      END