external/io_grib2/g2lib/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
  21 C USAGE:    CALL SKGB(LUGB,ISEEK,MSEEK,LSKIP,LGRIB)
  22 C   INPUT ARGUMENTS:
  23 C     LUGB         INTEGER LOGICAL UNIT OF INPUT GRIB FILE
  24 C     ISEEK        INTEGER NUMBER OF BYTES TO SKIP BEFORE SEARCH
  25 C     MSEEK        INTEGER MAXIMUM NUMBER OF BYTES TO SEARCH
  26 C   OUTPUT ARGUMENTS:
  27 C     LSKIP        INTEGER NUMBER OF BYTES TO SKIP BEFORE MESSAGE
  28 C     LGRIB        INTEGER NUMBER OF BYTES IN MESSAGE (0 IF NOT FOUND)
  29 C
  30 C SUBPROGRAMS CALLED:
  31 C   BAREAD       BYTE-ADDRESSABLE READ
  32 C   G2LIB_GBYTE         GET INTEGER DATA FROM BYTES
  33 C
  34 C ATTRIBUTES:
  35 C   LANGUAGE: FORTRAN
  36 C
  37 C$$$
  38       PARAMETER(LSEEK=128)
  39       CHARACTER Z(LSEEK)
  40       CHARACTER Z4(4)
  41 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  42       LGRIB=0
  43       KS=ISEEK
  44       KN=MIN(LSEEK,MSEEK)
  45       KZ=LSEEK
  46 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  47 C  LOOP UNTIL GRIB MESSAGE IS FOUND
  48       DOWHILE(LGRIB.EQ.0.AND.KN.GE.8.AND.KZ.EQ.LSEEK)
  49 C  READ PARTIAL SECTION
  50         CALL BAREAD(LUGB,KS,KN,KZ,Z)
  51         KM=KZ-8+1
  52         K=0
  53 C  LOOK FOR 'GRIB...1' IN PARTIAL SECTION
  54         DOWHILE(LGRIB.EQ.0.AND.K.LT.KM)
  55           CALL G2LIB_GBYTE(Z,I4,(K+0)*8,4*8)
  56           CALL G2LIB_GBYTE(Z,I1,(K+7)*8,1*8)
  57           IF(I4.EQ.1196575042.AND.(I1.EQ.1.OR.I1.EQ.2)) THEN
  58 C  LOOK FOR '7777' AT END OF GRIB MESSAGE
  59             IF (I1.EQ.1) CALL G2LIB_GBYTE(Z,KG,(K+4)*8,3*8)
  60             IF (I1.EQ.2) CALL G2LIB_GBYTE(Z,KG,(K+12)*8,4*8)
  61             CALL BAREAD(LUGB,KS+K+KG-4,4,K4,Z4)
  62             IF(K4.EQ.4) THEN
  63               CALL G2LIB_GBYTE(Z4,I4,0,4*8)
  64               IF(I4.EQ.926365495) THEN
  65 C  GRIB MESSAGE FOUND
  66                 LSKIP=KS+K
  67                 LGRIB=KG
  68               ENDIF
  69             ENDIF
  70           ENDIF
  71           K=K+1
  72         ENDDO
  73         KS=KS+KM
  74         KN=MIN(LSEEK,ISEEK+MSEEK-KS)
  75       ENDDO
  76 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  77       RETURN
  78       END