PROGRAM GRBINDEX
C$$$  MAIN PROGRAM DOCUMENTATION BLOCK
C
C MAIN PROGRAM: GRBINDEX     WRITE AN INDEX FILE
C   PRGMMR: IREDELL          ORG: NP23        DATE: 1998-09-15
C
C ABSTRACT: PROGRAM CREATES AN INDEX FILE FROM A GRIB FILE.
C   THE INDEX FILE SERVES AS A TABLE OF CONTENTS FOR THE GRIB FILE,
C   ENABLING QUICK ACCESS TO THE DATA.  THE GRIB FILE MUST BE UNBLOCKED,
C   BUT THERE CAN BE A GAP BEFORE THE FIRST GRIB MESSAGE OF AT MOST
C   32000 BYTES AND GAPS BETWEEN MESSAGES OF AT MOST 4000 BYTES.
C   THE TWO FILE NAMES ARE RETRIEVED FROM THE COMMAND LINE ARGUMENTS.
C   THE FIRST ARGUMENT IS THE NAME OF THE INPUT GRIB FILE.
C   THE SECOND ARGUMENT IS THE NAME OF THE OUTPUT INDEX FILE.
C   CURRENTLY, ONLY VERSION 1 OF GRIB CAN BE READ.
C   VERSION 1 OF THE INDEX FILE HAS THE FOLLOWING FORMAT:
C     81-BYTE S.LORD HEADER WITH 'GB1IX1' IN COLUMNS 42-47 FOLLOWED BY
C     81-BYTE HEADER WITH NUMBER OF BYTES TO SKIP BEFORE INDEX RECORDS,
C     NUMBER OF BYTES IN EACH INDEX RECORD, NUMBER OF INDEX RECORDS,
C     AND GRIB FILE BASENAME WRITTEN IN FORMAT ('IX1FORM:',3I10,2X,A40).
C     EACH FOLLOWING INDEX RECORD CORRESPONDS TO A GRIB MESSAGE
C     AND HAS THE INTERNAL FORMAT:
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   92-11-22  IREDELL
C   94-06-08  EBISUZAKI - ELIMINATE ISHELL CALLS
C   94-08-26  IREDELL   - 40 BYTE PDS EXTENSION
C   95-10-31  IREDELL   - CONSIDERABLY REDUCE I/O
C   96-10-31  IREDELL   - AUGMENTED OPTIONAL DEFINITIONS TO BYTE 320
C 1999-04-27  GILBERT   - Changed CALL EXIT(N) to CALL ERREXIT(N) so that
C                         the proper error return value is passed back to
C                         the shell.
C
C USAGE: grbindex gribfile indexfile
C
C INPUT FILE:
C   gribfile     UNBLOCKED GRIB FILE
C
C OUTPUT FILE:
C   indexfile    UNBLOCKED INDEX FILE
C
C SUBPROGRAMS CALLED:
C   IARGC        COUNT THE COMMAND LINE ARGUMENTS
C   GETARG       GET COMMAND LINE ARGUMENT
C   WRGI1H       WRITE INDEX HEADERS
C   GETGIR       GET INDEX BUFFER
C   BAWRITE      BYTE-ADDRESSABLE WRITE
C   ERRMSG       WRITE A MESSAGE TO STDERR
C   ERREXIT      EXIT WITH RETURN CODE
C
C EXIT STATES:
C   COND =   0 - SUCCESSFUL RUN
C   COND =   1 - GRIB MESSAGE NOT FOUND
C   COND =   2 - INCORRECT ARGUMENTS
C   COND =   8 - ERROR ACCESSING FILE
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 77
C   MACHINE: CRAYS, WORKSTATIONS
C
C$$$
      PARAMETER(MSK1=32000,MSK2=4000)
      CHARACTER CGB*256,CGI*256
      PARAMETER(MBUF=16*1024*1024)
      CHARACTER CBUF(MBUF)
      CHARACTER CARG*300
      INTEGER NARG,IARGC
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C  GET ARGUMENTS
      NARG=IARGC()
      IF(NARG.NE.2) THEN
        CALL ERRMSG('grbindex:  Incorrect usage')
        CALL ERRMSG('Usage: grbindex gribfile indexfile')
        CALL ERREXIT(2)
      ENDIF
      CALL GETARG(1,CGB)
      NCGB=LEN_TRIM(CGB)
      CALL BAOPENR(11,CGB(1:NCGB),IOS)
      CALL BASETO(1,1)
      IF(IOS.NE.0) THEN
        LCARG=LEN('grbindex:  Error accessing file '//CGB(1:NCGB))
        CARG(1:LCARG)='grbindex:  Error accessing file '//CGB(1:NCGB)
        CALL ERRMSG(CARG(1:LCARG))
        CALL ERREXIT(8)
      ENDIF
      CALL GETARG(2,CGI)
      NCGI=LEN_TRIM(CGI)
      CALL BAOPEN(31,CGI(1:NCGI),IOS)
      IF(IOS.NE.0) THEN
        LCARG=LEN('grbindex:  Error accessing file '//CGI(1:NCGI))
        CARG(1:LCARG)='grbindex:  Error accessing file '//CGI(1:NCGI)
        CALL ERRMSG(CARG(1:LCARG))
        CALL ERREXIT(8)
      ENDIF
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C  WRITE INDEX FILE
      MNUM=0
      CALL GETGIR(11,MSK1,MSK2,MNUM,MBUF,CBUF,NLEN,NNUM,IRGI)
      IF(IRGI.GT.1.OR.NNUM.EQ.0) THEN
        CALL ERRMSG('grbindex:  No GRIB messages detected in file '
     &              //CGB(1:NCGB))
        CALL BACLOSE(11,IRET)
        CALL BACLOSE(31,IRET)
        CALL ERREXIT(1)
      ENDIF
      MNUM=MNUM+NNUM
      CALL WRGI1H(31,NLEN,MNUM,CGB(1:NCGB))
      IW=162
      CALL BAWRITE(31,IW,NLEN*NNUM,KW,CBUF)
      IW=IW+NLEN*NNUM
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C  EXTEND INDEX FILE IF INDEX BUFFER LENGTH GREATER THAN MBUF
      IF(IRGI.EQ.1) THEN
        DOWHILE(IRGI.EQ.1.AND.NNUM.GT.0)
          CALL GETGIR(11,MSK1,MSK2,MNUM,MBUF,CBUF,NLEN,NNUM,IRGI)
          IF(IRGI.LE.1.AND.NNUM.GT.0) THEN
            MNUM=MNUM+NNUM
            CALL BAWRITE(31,IW,NLEN*NNUM,KW,CBUF)
            IW=IW+NLEN*NNUM
          ENDIF
        ENDDO
        CALL WRGI1H(31,NLEN,MNUM,CGB(1:NCGB))
      ENDIF
      CALL BACLOSE(11,IRET)
      CALL BACLOSE(31,IRET)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      END
C-----------------------------------------------------------------------
      SUBROUTINE WRGI1H(LUGI,NLEN,NNUM,CGB)
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: WRGI1H         WRITE INDEX HEADERS
C   PRGMMR: IREDELL          ORG: W/NMC23     DATE: 93-11-22
C
C ABSTRACT: THIS SUBPROGRAM WRITES TWO INDEX HEADERS.
C   CURRENTLY, THE LENGTH OF EACH INDEX RECORD IS 152.
C
C PROGRAM HISTORY LOG:
C   93-11-22  IREDELL
C   95-10-31  IREDELL   - MODULARIZE SYSTEM CALLS
C
C USAGE:    CALL WRGI1H(LUGI,NLEN,NNUM,CGB)
C   INPUT ARGUMENTS:
C     LUGI         INTEGER LOGICAL UNIT OF OUTPUT INDEX FILE
C     NLEN         INTEGER LENGTH OF INDEX RECORDS
C     NNUM         INTEGER NUMBER OF INDEX RECORDS
C     CGB          CHARACTER NAME OF GRIB FILE
C
C SUBPROGRAMS CALLED:
C   NCBASE       GET BASENAME OF FILE
C   HOSTNAME     GET SYSTEM NAME
C   BAWRITE      BYTE-ADDRESSABLE WRITE
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN
C
C$$$
      CHARACTER CGB*(*)
      CHARACTER CD8*8,CT10*10,HOSTNAME*15
      CHARACTER CHEAD(2)*81
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C  FILL FIRST 81-BYTE HEADER
      NCGB=LEN(CGB)
      NCGB1=NCBASE(CGB,NCGB)
      NCGB2=NCBASE(CGB,NCGB1-2)
      CALL DATE_AND_TIME(CD8,CT10)
      CHEAD(1)='!GFHDR!'
      CHEAD(1)(9:10)=' 1'
      CHEAD(1)(12:14)='  1'
      WRITE(CHEAD(1)(16:20),'(I5)') 162
      CHEAD(1)(22:31)=CD8(1:4)//'-'//CD8(5:6)//'-'//CD8(7:8)
      CHEAD(1)(33:40)=CT10(1:2)//':'//CT10(3:4)//':'//CT10(5:6)
      CHEAD(1)(42:47)='GB1IX1'
      CHEAD(1)(49:54)=CGB(NCGB2:NCGB1-2)
      CHEAD(1)(56:70)=HOSTNAME()
      CHEAD(1)(72:80)='grbindex '
      CHEAD(1)(81:81)=CHAR(10)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C  FILL SECOND 81-BYTE HEADER
      CHEAD(2)='IX1FORM:'
      WRITE(CHEAD(2)(9:38),'(3I10)') 162,NLEN,NNUM
      CHEAD(2)(41:80)=CGB(NCGB1:NCGB)
      CHEAD(2)(81:81)=CHAR(10)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C  WRITE HEADERS AT BEGINNING OF INDEX FILE
      CALL BAWRITE(LUGI,0,162,KW,CHEAD)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      RETURN
      END
C-----------------------------------------------------------------------
      FUNCTION NCBASE(C,N)
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: NCBASE         LOCATE BASENAME OF A FILE
C   PRGMMR: IREDELL          ORG: W/NMC23     DATE: 93-11-22
C
C ABSTRACT: THIS SUBPROGRAM LOCATES THE CHARACTER NUMBER AFTER THE LAST 
C   IN A CHARACTER STRING.  FOR UNIX FILENAMES, THE CHARACTER NUMBER
C   RETURNED MARKS THE BEGINNING OF THE BASENAME OF THE FILE.
C
C PROGRAM HISTORY LOG:
C   93-11-22  IREDELL
C
C USAGE:     ...=NCBASE(C,N)
C   INPUT ARGUMENTS:
C     C            CHARACTER STRING TO SEARCH
C     N            INTEGER LENGTH OF STRING
C
C ATTRIBUTES:
C   LANGUAGE: CRAY FORTRAN
C
C$$$
      CHARACTER C*(*)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      K=N
      DOWHILE(K.GE.1.AND.C(K:K).NE.'/')
        K=K-1
      ENDDO
      NCBASE=K+1
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      RETURN
      END