ungrib/src/ngl/g2/skgb.f

   1 C-----------------------------------------------------------------------
   2       SUBROUTINE SKGB(LUGB,ISEEK,MSEEK,LSKIP,LGRIB)
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM: SKGB           SEARCH FOR NEXT GRIB MESSAGE
   6 C   PRGMMR: IREDELL          ORG: W/NMC23     DATE: 93-11-22
   7 C
   8 C ABSTRACT: THIS SUBPROGRAM SEARCHES A FILE FOR THE NEXT GRIB 1 MESSAGE.
   9 C   A GRIB 1 MESSAGE IS IDENTIFIED BY ITS INDICATOR SECTION, I.E.
  10 C   AN 8-BYTE SEQUENCE WITH 'GRIB' IN BYTES 1-4 AND 1 IN BYTE 8.
  11 C   IF FOUND, THE LENGTH OF THE MESSAGE IS DECODED FROM BYTES 5-7.
  12 C   THE SEARCH IS DONE OVER A GIVEN SECTION OF THE FILE.
  13 C   THE SEARCH IS TERMINATED IF AN EOF OR I/O ERROR IS ENCOUNTERED.
  14 C
  15 C PROGRAM HISTORY LOG:
  16 C   93-11-22  IREDELL
  17 C   95-10-31  IREDELL   ADD CALL TO BAREAD
  18 C   97-03-14  IREDELL   CHECK FOR '7777'
  19 C 2001-12-05  GILBERT   MODIFIED TO ALSO LOOK FOR GRIB2 MESSAGES
  20 C 2009-12-14  VUONG     MODIFIED TO INCREASE LENGTH OF SEEK (512)
  21 C
  22 C USAGE:    CALL SKGB(LUGB,ISEEK,MSEEK,LSKIP,LGRIB)
  23 C   INPUT ARGUMENTS:
  24 C     LUGB         INTEGER LOGICAL UNIT OF INPUT GRIB FILE
  25 C     ISEEK        INTEGER NUMBER OF BYTES TO SKIP BEFORE SEARCH
  26 C     MSEEK        INTEGER MAXIMUM NUMBER OF BYTES TO SEARCH
  27 C   OUTPUT ARGUMENTS:
  28 C     LSKIP        INTEGER NUMBER OF BYTES TO SKIP BEFORE MESSAGE
  29 C     LGRIB        INTEGER NUMBER OF BYTES IN MESSAGE (0 IF NOT FOUND)
  30 C
  31 C SUBPROGRAMS CALLED:
  32 C   BAREAD       BYTE-ADDRESSABLE READ
  33 C   GBYTE         GET INTEGER DATA FROM BYTES
  34 C
  35 C ATTRIBUTES:
  36 C   LANGUAGE: FORTRAN
  37 C
  38 C$$$
  39       PARAMETER(LSEEK=512)
  40       CHARACTER Z(LSEEK)
  41       CHARACTER Z4(4)
  42 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  43       LGRIB=0
  44       KS=ISEEK
  45       KN=MIN(LSEEK,MSEEK)
  46       KZ=LSEEK
  47 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  48 C  LOOP UNTIL GRIB MESSAGE IS FOUND
  49       DOWHILE(LGRIB.EQ.0.AND.KN.GE.8.AND.KZ.EQ.LSEEK)
  50 C  READ PARTIAL SECTION
  51         CALL BAREAD(LUGB,KS,KN,KZ,Z)
  52         KM=KZ-8+1
  53         K=0
  54 C  LOOK FOR 'GRIB...1' IN PARTIAL SECTION
  55         DOWHILE(LGRIB.EQ.0.AND.K.LT.KM)
  56           CALL GBYTE(Z,I4,(K+0)*8,4*8)
  57           CALL GBYTE(Z,I1,(K+7)*8,1*8)
  58           IF(I4.EQ.1196575042.AND.(I1.EQ.1.OR.I1.EQ.2)) THEN
  59 C  LOOK FOR '7777' AT END OF GRIB MESSAGE
  60             IF (I1.EQ.1) CALL GBYTE(Z,KG,(K+4)*8,3*8)
  61             IF (I1.EQ.2) CALL GBYTE(Z,KG,(K+12)*8,4*8)
  62             CALL BAREAD(LUGB,KS+K+KG-4,4,K4,Z4)
  63             IF(K4.EQ.4) THEN
  64               CALL GBYTE(Z4,I4,0,4*8)
  65               IF(I4.EQ.926365495) THEN
  66 C  GRIB MESSAGE FOUND
  67                 LSKIP=KS+K
  68                 LGRIB=KG
  69               ENDIF
  70             ENDIF
  71           ENDIF
  72           K=K+1
  73         ENDDO
  74         KS=KS+KM
  75         KN=MIN(LSEEK,ISEEK+MSEEK-KS)
  76       ENDDO
  77 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  78       RETURN
  79       END