C-----------------------------------------------------------------------
      PROGRAM GRBINDEX
C$$$  MAIN PROGRAM DOCUMENTATION BLOCK
C
C MAIN PROGRAM:  GRBINDEX    WRITE AN INDEX FILE
C   PRGMMR: IREDELL          ORG: NP23        DATE: 95-10-31
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   97-07-02  EBISUZAKI - LINUX PORT
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   ISTRLEN      STRING LENGTH
C   GETARG       GET COMMAND LINE ARGUMENT
C   GIOPEN       OPEN FILES
C   WRGI1H       WRITE INDEX HEADERS
C   GETGIR       GET INDEX BUFFER
C   WRYTE        WRITE BUFFER
C   GICLOSE      CLOSE FILES
C   ERRMSG       WRITE A MESSAGE TO STDERR
C   EXIT         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=3*1024*1024)
      CHARACTER*1 CBUF(MBUF)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C  GET ARGUMENTS
      NARG =  IARGC()
      IF(NARG.NE.2) THEN
        CALL ERRMSG('grbindex:  Incorrect usage')
        CALL ERRMSG('Usage: grbindex gribfile indexfile')
        CALL EXIT(2)
      ENDIF
c     NCGB=GETARG(1,CGB)
      call GETARG(1,CGB)
      NCGB=ISTRLEN(CGB)
c     NCGI=GETARG(2,CGI)
      call GETARG(2,CGI)
      NCGI=ISTRLEN(CGI)
      CALL GIOPEN(11,CGB(1:NCGB),31,CGI(1:NCGI))
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 GICLOSE(11,31)
        CALL EXIT(1)
      ENDIF
      MNUM=MNUM+NNUM
      CALL WRGI1H(31,NLEN,MNUM,CGB(1:NCGB),CGI(1:NCGI))
      CALL WRYTE(31,NLEN*NNUM,CBUF)
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 WRYTE(31,NLEN*NNUM,CBUF)
          ENDIF
        ENDDO
        CALL WRGI1H(31,NLEN,MNUM,CGB(1:NCGB),CGI(1:NCGI))
      ENDIF
      CALL GICLOSE(11,31)
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      END
C-----------------------------------------------------------------------
      SUBROUTINE WRGI1H(LUGI,NLEN,NNUM,CGB,CGI)
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   GISYS        GET SYSTEM INFORMATION
C   WRYTE        WRITE BUFFER
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN
C
C$$$
      CHARACTER CGB*(*), CGI*(*)
      CHARACTER CNSYS*15,CDATE*10,CTIME*8
      CHARACTER CHEAD(2)*81
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C  FILL FIRST 81-BYTE HEADER
      NCGB=LEN(CGB)
      NCGB1=NCBASE(CGB,NCGB)
      NCGB2=NCBASE(CGB,NCGB1-2)
      CALL GISYS(CNSYS,CDATE,CTIME)
      CHEAD(1)='!GFHDR!'
      CHEAD(1)(9:10)=' 1'
      CHEAD(1)(12:14)='  1'
      WRITE(CHEAD(1)(16:20),'(I5)') 162
      CHEAD(1)(22:31)=CDATE
      CHEAD(1)(33:40)=CTIME
      CHEAD(1)(42:47)='GB1IX1'
      CHEAD(1)(49:54)=CGB(NCGB2:NCGB1-2)
      CHEAD(1)(56:70)=CNSYS
      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
C     REWIND LUGI 
      CLOSE(LUGI)
      CALL BAOPEN(31,CGI,IOS)
      IF(IOS.NE.0) THEN
        CALL ERRMSG('grbindex:  Error accessing index file ')
        CALL EXIT(8)
      ENDIF

      CALL WRYTE(LUGI,162,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
        INTEGER FUNCTION ISTRLEN(C)
        CHARACTER*(*) C
        L = LEN(C)
        DO ISTRLEN = L, 1, -1
           IF (C(ISTRLEN:ISTRLEN).NE.' ') RETURN
        ENDDO
        ISTRLEN = 0
        RETURN
        END
