ungrib/src/ngl/w3/getgb1re.f

   1 C-----------------------------------------------------------------------
   2       SUBROUTINE GETGB1RE(LUGB,LSKIP,LGRIB,KF,KPDS,KGDS,KENS,
   3      &                    KPROB,XPROB,KCLUST,KMEMBR,LB,F,IRET)
   4 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   5 C
   6 C SUBPROGRAM: GETGB1RE       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   97-02-11  Y.ZHU       INCLUDED PROBABILITY AND CLUSTER ARGUMENTS
  14 C
  15 C USAGE:    CALL GETGB1RE(LUGB,LSKIP,LGRIB,KF,KPDS,KGDS,KENS,
  16 C    &                    KPROB,XPROB,KCLUST,KMEMBR,LB,F,IRET)
  17 C   INPUT ARGUMENTS:
  18 C     LUGB         INTEGER UNIT OF THE UNBLOCKED GRIB DATA FILE
  19 C     LSKIP        INTEGER NUMBER OF BYTES TO SKIP
  20 C     LGRIB        INTEGER NUMBER OF BYTES TO READ
  21 C   OUTPUT ARGUMENTS:
  22 C     KF           INTEGER NUMBER OF DATA POINTS UNPACKED
  23 C     KPDS         INTEGER (200) UNPACKED PDS PARAMETERS
  24 C     KGDS         INTEGER (200) UNPACKED GDS PARAMETERS
  25 C     KENS         INTEGER (200) UNPACKED ENSEMBLE PDS PARMS
  26 C     KPROB        INTEGER (2) PROBABILITY ENSEMBLE PARMS
  27 C     XPROB        REAL    (2) PROBABILITY ENSEMBLE PARMS
  28 C     KCLUST       INTEGER (16) CLUSTER ENSEMBLE PARMS
  29 C     KMEMBR       INTEGER (8) CLUSTER ENSEMBLE PARMS
  30 C     LB           LOGICAL*1 (KF) UNPACKED BITMAP IF PRESENT
  31 C     F            REAL (KF) UNPACKED DATA
  32 C     IRET         INTEGER RETURN CODE
  33 C                    0      ALL OK
  34 C                    97     ERROR READING GRIB FILE
  35 C                    OTHER  W3FI63 GRIB UNPACKER RETURN CODE
  36 C
  37 C SUBPROGRAMS CALLED:
  38 C   BAREAD         BYTE-ADDRESSABLE READ
  39 C   W3FI63         UNPACK GRIB
  40 C   PDSEUP         UNPACK PDS EXTENSION
  41 C
  42 C REMARKS: THERE IS NO PROTECTION AGAINST UNPACKING TOO MUCH DATA.
  43 C   SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT.
  44 C   DO NOT ENGAGE THE SAME LOGICAL UNIT FROM MORE THAN ONE PROCESSOR.
  45 C   THIS SUBPROGRAM IS INTENDED FOR PRIVATE USE BY GETGB ROUTINES ONLY.
  46 C
  47 C ATTRIBUTES:
  48 C   LANGUAGE: FORTRAN 77
  49 C   MACHINE:  CRAY, WORKSTATIONS
  50 C
  51 C$$$
  52       INTEGER KPDS(200),KGDS(200),KENS(200)
  53       INTEGER KPROB(2),KCLUST(16),KMEMBR(80)
  54       REAL XPROB(2)
  55       LOGICAL*1 LB(*)
  56       REAL F(*)
  57       INTEGER KPTR(200)
  58       CHARACTER GRIB(LGRIB)*1
  59 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  60 C  READ GRIB RECORD
  61       CALL BAREAD(LUGB,LSKIP,LGRIB,LREAD,GRIB)
  62 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  63 C  UNPACK GRIB RECORD
  64       IF(LREAD.EQ.LGRIB) THEN
  65         CALL W3FI63(GRIB,KPDS,KGDS,LB,F,KPTR,IRET)
  66         IF(IRET.EQ.0.AND.KPDS(23).EQ.2) THEN
  67           CALL PDSEUP(KENS,KPROB,XPROB,KCLUST,KMEMBR,86,GRIB(9))
  68         ENDIF
  69       ELSE
  70         IRET=97
  71       ENDIF
  72 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  73 C  RETURN NUMBER OF POINTS
  74       IF(IRET.EQ.0) THEN
  75         KF=KPTR(10)
  76       ELSE
  77         KF=0
  78       ENDIF
  79 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  80       RETURN
  81       END