SUBROUTINE GETGB1(LUGB,LUGI,JF,J,JPDS,JGDS, & GRIB,KF,K,KPDS,KGDS,LB,F,IRET) C$$$ SUBPROGRAM DOCUMENTATION BLOCK C C SUBPROGRAM: GETGB1 FINDS AND UNPACKS A GRIB MESSAGE C PRGMMR: IREDELL ORG: W/NMC23 DATE: 94-04-01 C C ABSTRACT: FIND AND UNPACK A GRIB MESSAGE. C READ AN ASSOCIATED GRIB INDEX FILE (UNLESS IT ALREADY WAS READ). C FIND IN THE INDEX FILE A REFERENCE TO THE GRIB MESSAGE REQUESTED. C THE GRIB MESSAGE REQUEST SPECIFIES THE NUMBER OF MESSAGES TO SKIP C AND THE UNPACKED PDS AND GDS PARAMETERS. (A REQUESTED PARAMETER C OF -1 MEANS TO ALLOW ANY VALUE OF THIS PARAMETER TO BE FOUND.) C IF THE REQUESTED GRIB MESSAGE IS FOUND, THEN IT IS READ FROM THE C GRIB FILE AND UNPACKED. ITS MESSAGE NUMBER IS RETURNED ALONG WITH C THE UNPACKED PDS AND GDS PARAMETERS, THE UNPACKED BITMAP (IF ANY), C AND THE UNPACKED DATA. IF THE GRIB MESSAGE IS NOT FOUND, THEN THE C RETURN CODE WILL BE NONZERO. C C PROGRAM HISTORY LOG: C 94-04-01 IREDELL C 95-05-10 R.E.JONES ADD ONE MORE PARAMETER TO GETGB AND C CHANGE NAME TO GETGB1 C C USAGE: CALL GETGB1(LUGB,LUGI,JF,J,JPDS,JGDS, C & GRIB,KF,K,KPDS,KGDS,LB,F,IRET) C INPUT ARGUMENTS: C LUGB LOGICAL UNIT OF THE UNBLOCKED GRIB DATA FILE C LUGI LOGICAL UNIT OF THE UNBLOCKED GRIB INDEX FILE C JF INTEGER MAXIMUM NUMBER OF DATA POINTS TO UNPACK C J INTEGER NUMBER OF MESSAGES TO SKIP C (=0 TO SEARCH FROM BEGINNING) C (<0 TO REOPEN INDEX FILE AND SEARCH FROM BEGINNING) C JPDS INTEGER (25) PDS PARAMETERS FOR WHICH TO SEARCH C (=-1 FOR WILDCARD) C LOOK IN DOC BLOCK OF W3FI63 FOR ARRAY KPDS C FOR LIST OF ORDER OF UNPACKED PDS VALUES. IN C MOST CASES YOU ONLY NEED TO SET 4 OR 5 VALUES C TO PICK UP RECORD. C JGDS INTEGER (22) GDS PARAMETERS FOR WHICH TO SEARCH C (ONLY SEARCHED IF JPDS(3)=255) C (=-1 FOR WILDCARD) C OUTPUT ARGUMENTS: C GRIB GRIB DATA ARRAY BEFORE IT IS UNPACKED C KF INTEGER NUMBER OF DATA POINTS UNPACKED C K INTEGER MESSAGE NUMBER UNPACKED C (CAN BE SAME AS J IN CALLING PROGRAM C IN ORDER TO FACILITATE MULTIPLE SEARCHES) C KPDS INTEGER (25) UNPACKED PDS PARAMETERS C KGDS INTEGER (22) UNPACKED GDS PARAMETERS C LB LOGICAL (KF) UNPACKED BITMAP IF PRESENT C F REAL (KF) UNPACKED DATA C IRET INTEGER RETURN CODE C 0 ALL OK C 96 ERROR READING INDEX FILE C 97 ERROR READING GRIB FILE C 98 NUMBER OF DATA POINTS GREATER THAN JF C 99 REQUEST NOT FOUND C OTHER W3FI63 GRIB UNPACKER RETURN CODE C C SUBPROGRAMS CALLED: C BAREAD BYTE-ADDRESSABLE READ C GBYTE UNPACK BYTES C FI632 UNPACK PDS C FI633 UNPACK GDS C W3FI63 UNPACK GRIB C C ATTRIBUTES: C LANGUAGE: CRAY CFT77 FORTRAN C MACHINE: CRAY C916/256, J916/2048 C C$$$ C PARAMETER (MBUF=8192*128) PARAMETER (LPDS=23,LGDS=22) C INTEGER JPDS(25),JGDS(*),KPDS(25),KGDS(*) INTEGER IPDSP(LPDS),JPDSP(LPDS),IGDSP(LGDS) INTEGER JGDSP(LGDS) INTEGER KPTR(20) C LOGICAL LB(*) C REAL F(*) C CHARACTER CBUF(MBUF) CHARACTER*81 CHEAD(2) CHARACTER*1 CPDS(28) CHARACTER*1 CGDS(42) CHARACTER*1 GRIB(*) C C SAVE LUX,NSKP,NLEN,NNUM,CBUF SAVE C DATA LUX/0/ C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - C READ INDEX FILE IF(J.LT.0.OR.LUGI.NE.LUX) THEN C REWIND LUGI C READ(LUGI,fmt='(2A81)',IOSTAT=IOS) CHEAD CALL BAREAD(LUGI,0,162,ios,chead) IF(IOS.EQ.162.AND.CHEAD(1)(42:47).EQ.'GB1IX1') THEN LUX=0 READ(CHEAD(2),'(8X,3I10,2X,A40)',IOSTAT=IOS) NSKP,NLEN,NNUM IF(IOS.EQ.0) THEN NBUF=NNUM*NLEN IF(NBUF.GT.MBUF) THEN PRINT *,'GETGB1: INCREASE BUFFER FROM ',MBUF,' TO ',NBUF NNUM=MBUF/NLEN NBUF=NNUM*NLEN ENDIF CALL BAREAD(LUGI,NSKP,NBUF,LBUF,CBUF) IF(LBUF.EQ.NBUF) THEN LUX=LUGI J=MAX(J,0) ENDIF ENDIF ENDIF ENDIF C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - C SEARCH FOR REQUEST LGRIB=0 KJ=J K=J KF=0 IF(J.GE.0.AND.LUGI.EQ.LUX) THEN LPDSP=0 DO I=1,LPDS IF(JPDS(I).NE.-1) THEN LPDSP=LPDSP+1 IPDSP(LPDSP)=I JPDSP(LPDSP)=JPDS(I) ENDIF ENDDO LGDSP=0 IF(JPDS(3).EQ.255) THEN DO I=1,LGDS IF(JGDS(I).NE.-1) THEN LGDSP=LGDSP+1 IGDSP(LGDSP)=I JGDSP(LGDSP)=JGDS(I) ENDIF ENDDO ENDIF IRET=99 DOWHILE(LGRIB.EQ.0.AND.KJ.LT.NNUM) KJ=KJ+1 LT=0 IF(LPDSP.GT.0) THEN CPDS=CBUF((KJ-1)*NLEN+26:(KJ-1)*NLEN+53) KPTR=0 CALL GBYTE(CBUF,KPTR(3),(KJ-1)*NLEN*8+25*8,3*8) CALL FI632(CPDS,KPTR,KPDS,IRET) DO I=1,LPDSP IP=IPDSP(I) LT=LT+ABS(JPDS(IP)-KPDS(IP)) ENDDO ENDIF IF(LT.EQ.0.AND.LGDSP.GT.0) THEN CGDS=CBUF((KJ-1)*NLEN+54:(KJ-1)*NLEN+95) KPTR=0 CALL FI633(CGDS,KPTR,KGDS,IRET) DO I=1,LGDSP IP=IGDSP(I) LT=LT+ABS(JGDS(IP)-KGDS(IP)) ENDDO ENDIF C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - C READ AND UNPACK GRIB DATA IF(LT.EQ.0) THEN CALL GBYTE(CBUF,LSKIP,(KJ-1)*NLEN*8,4*8) CALL GBYTE(CBUF,LGRIB,(KJ-1)*NLEN*8+20*8,4*8) CGDS=CBUF((KJ-1)*NLEN+54:(KJ-1)*NLEN+95) KPTR=0 CALL FI633(CGDS,KPTR,KGDS,IRET) C BSM IF(LGRIB.LE.200+17*JF/8.AND.KGDS(2)*KGDS(3).LE.JF) THEN C Change number of bits that can be handled to 25 IF(LGRIB.LE.200+25*JF/8.AND.KGDS(2)*KGDS(3).LE.JF) THEN CALL BAREAD(LUGB,LSKIP,LGRIB,LREAD,GRIB) IF(LREAD.EQ.LGRIB) THEN CALL W3FI63(GRIB,KPDS,KGDS,LB,F,KPTR,IRET) IF(IRET.EQ.0) THEN K=KJ KF=KPTR(10) ENDIF ELSE IRET=97 ENDIF ELSE IRET=98 ENDIF ENDIF ENDDO ELSE IRET=96 ENDIF C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN END