| [2759] | 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 |
|---|
