ungrib/src/ngl/w3/getgb1r.f

   1 C-----------------------------------------------------------------------
   2       SUBROUTINE GETGB1R(LUGB,LSKIP,LGRIB,KF,KPDS,KGDS,KENS,LB,F,NBITSS
   3      +      ,IRET)
   4 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   5 C
   6 C SUBPROGRAM: GETGB1R        READS AND UNPACKS A GRIB MESSAGE
   7 C   PRGMMR: IREDELL          ORG: W/NMC23     DATE: 95-10-31
   8 C
   9 C ABSTRACT: READ AND UNPACK A GRIB MESSAGE.
  10 C
  11 C PROGRAM HISTORY LOG:
  12 C   95-10-31  IREDELL
  13 C   04-07-22  CHUANG  ADD PACKING BIT NUMBER NBITSS IN THE ARGUMENT
  14 C            LIST BECAUSE ETA GRIB FILES NEED IT TO REPACK GRIB FILE
  15 C USAGE:    CALL GETGB1R(LUGB,LSKIP,LGRIB,KF,KPDS,KGDS,KENS,LB,F,IRET)
  16 C   INPUT ARGUMENTS:
  17 C     LUGB         INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE
  18 C     LSKIP        INTEGER NUMBER OF BYTES TO SKIP
  19 C     LGRIB        INTEGER NUMBER OF BYTES TO READ
  20 C   OUTPUT ARGUMENTS:
  21 C     KF           INTEGER NUMBER OF DATA POINTS UNPACKED
  22 C     KPDS         INTEGER (200) UNPACKED PDS PARAMETERS
  23 C     KGDS         INTEGER (200) UNPACKED GDS PARAMETERS
  24 C     KENS         INTEGER (200) UNPACKED ENSEMBLE PDS PARMS
  25 C     LB           LOGICAL*1 (KF) UNPACKED BITMAP IF PRESENT
  26 C     F            REAL (KF) UNPACKED DATA
  27 C     IRET         INTEGER RETURN CODE
  28 C                    0      ALL OK
  29 C                    97     ERROR READING GRIB FILE
  30 C                    OTHER  W3FI63 GRIB UNPACKER RETURN CODE
  31 C
  32 C SUBPROGRAMS CALLED:
  33 C   BAREAD         BYTE-ADDRESSABLE READ
  34 C   W3FI63         UNPACK GRIB
  35 C   PDSEUP         UNPACK PDS EXTENSION
  36 C
  37 C REMARKS: THERE IS NO PROTECTION AGAINST UNPACKING TOO MUCH DATA.
  38 C   SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT.
  39 C   DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR.
  40 C   THIS SUBPROGRAM IS INTENDED FOR PRIVATE USE BY GETGB ROUTINES ONLY.
  41 C
  42 C ATTRIBUTES:
  43 C   LANGUAGE: FORTRAN 77
  44 C   MACHINE:  CRAY, WORKSTATIONS
  45 C
  46 C$$$
  47       INTEGER KPDS(200),KGDS(200),KENS(200)
  48       LOGICAL*1 LB(*)
  49       REAL F(*)
  50       INTEGER KPTR(200)
  51       CHARACTER GRIB(LGRIB)*1
  52 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  53 C  READ GRIB RECORD
  54       CALL BAREAD(LUGB,LSKIP,LGRIB,LREAD,GRIB)
  55 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  56 C  UNPACK GRIB RECORD
  57       IF(LREAD.EQ.LGRIB) THEN
  58         CALL W3FI63(GRIB,KPDS,KGDS,LB,F,KPTR,IRET)
  59         IF(IRET.EQ.0.AND.KPDS(23).EQ.2) THEN
  60           CALL PDSEUP(KENS,KPROB,XPROB,KCLUST,KMEMBR,45,GRIB(9))
  61         ENDIF
  62       ELSE
  63         IRET=97
  64       ENDIF
  65       NBITSS=KPTR(20)
  66 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  67 C  RETURN NUMBER OF POINTS
  68       IF(IRET.EQ.0) THEN
  69         KF=KPTR(10)
  70       ELSE
  71         KF=0
  72       ENDIF
  73 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  74       RETURN
  75       END