SUBROUTINE GETGIR(LUGB,MSK1,MSK2,MNUM,MBUF,CBUF,NLEN,NNUM,IRET) C$$$ SUBPROGRAM DOCUMENTATION BLOCK C C SUBPROGRAM: GETGIR READS A GRIB INDEX FILE C PRGMMR: IREDELL ORG: W/NMC23 DATE: 95-10-31 C C ABSTRACT: READ A GRIB FILE AND RETURN ITS INDEX CONTENTS. C SEE SUBPROGRAM IXGB FOR DOCUMENTATION OF THE INDEX BUFFER STRUCTURE. C C PROGRAM HISTORY LOG: C 95-10-31 IREDELL C C USAGE: CALL GETGIR(LUGB,MSK1,MSK2,MBUF,CBUF,NLEN,NNUM,IRET) C INPUT ARGUMENTS: C LUGB INTEGER UNIT OF THE UNBLOCKED GRIB FILE C MSK1 INTEGER NUMBER OF BYTES TO SEARCH FOR FIRST MESSAGE C MSK2 INTEGER NUMBER OF BYTES TO SEARCH FOR OTHER MESSAGES C MNUM INTEGER NUMBER OF INDEX RECORDS TO SKIP (USUALLY 0) C MBUF INTEGER LENGTH OF CBUF IN BYTES C OUTPUT ARGUMENTS: C CBUF CHARACTER*1 (MBUF) BUFFER TO RECEIVE INDEX DATA C NLEN INTEGER LENGTH OF EACH INDEX RECORD IN BYTES C NNUM INTEGER NUMBER OF INDEX RECORDS C (=0 IF NO GRIB MESSAGES ARE FOUND) C IRET INTEGER RETURN CODE C 0 ALL OK C 1 CBUF TOO SMALL TO HOLD INDEX DATA C C SUBPROGRAMS CALLED: C SKGB SEEK NEXT GRIB MESSAGE C IXGB MAKE INDEX RECORD C C REMARKS: SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. C DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR. C C ATTRIBUTES: C LANGUAGE: FORTRAN 77 C MACHINE: CRAY, WORKSTATIONS C C$$$ CHARACTER CBUF(MBUF) PARAMETER(LINDEX=152) C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - C SEARCH FOR FIRST GRIB MESSAGE ISEEK=0 CALL SKGB(LUGB,ISEEK,MSK1,LSKIP,LGRIB) write(*,*) 'getgir 1: lgrib=',lgrib DO M=1,MNUM IF(LGRIB.GT.0) THEN ISEEK=LSKIP+LGRIB CALL SKGB(LUGB,ISEEK,MSK2,LSKIP,LGRIB) write(*,*) 'getgir 2: lgrib=',lgrib ENDIF ENDDO C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - C MAKE AN INDEX RECORD FOR EVERY GRIB RECORD FOUND NLEN=LINDEX NNUM=0 IRET=0 write(*,*) 'getgir: IRET=',IRET, ' lgrib-', lgrib, ' lskip=',skip DOWHILE(IRET.EQ.0.AND.LGRIB.GT.0) IF(NLEN*(NNUM+1).LE.MBUF) THEN NNUM=NNUM+1 CALL IXGB(LUGB,LSKIP,LGRIB,NLEN,NNUM,CBUF) ISEEK=LSKIP+LGRIB CALL SKGB(LUGB,ISEEK,MSK2,LSKIP,LGRIB) write(*,*) 'getgir 4: lgrib=',lgrib ELSE IRET=1 ENDIF ENDDO C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN END