*IF DEF,C98_1A,OR,DEF,FLDIO,OR,DEF,RECON,OR,DEF,CAMDUMP,OR,DEF,UTILIO      GAV0F405.102    
C ******************************COPYRIGHT******************************    GTS2F400.1801   
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.    GTS2F400.1802   
C                                                                          GTS2F400.1803   
C Use, duplication or disclosure of this code is subject to the            GTS2F400.1804   
C restrictions as set forth in the contract.                               GTS2F400.1805   
C                                                                          GTS2F400.1806   
C                Meteorological Office                                     GTS2F400.1807   
C                London Road                                               GTS2F400.1808   
C                BRACKNELL                                                 GTS2F400.1809   
C                Berkshire UK                                              GTS2F400.1810   
C                RG12 2SZ                                                  GTS2F400.1811   
C                                                                          GTS2F400.1812   
C If no contract has been raised with this copy of the code, the use,      GTS2F400.1813   
C duplication or disclosure of it is strictly prohibited.  Permission      GTS2F400.1814   
C to do so must first be obtained in writing from the Head of Numerical    GTS2F400.1815   
C Modelling at the above address.                                          GTS2F400.1816   
C ******************************COPYRIGHT******************************    GTS2F400.1817   
C                                                                          GTS2F400.1818   

      SUBROUTINE DEGRIB(FIELD,WORK_ARRAY,IDIM,NUM_CRAY_WORDS,               4,1DEGRIB1.3      
     &                   ILABEL,AMDI,NUM_UNPACK_VALUES,LEN_FULL_WORD)      DEGRIB1.4      
CLL                                                                        DEGRIB1.5      
CLL  Routine: DEGRIB----------------------------------------------         DEGRIB1.6      
CLL                                                                        DEGRIB1.7      
CLL  Purpose: Routine to unpack GRIB record from field and return in       DEGRIB1.8      
CLL           WORK_ARRAY                                                   DEGRIB1.9      
CLL                                                                        DEGRIB1.10     
CLL  Author: P.J.Smith        Date: 9  September 1994                      DEGRIB1.11     
CLL  Reviewer:  Date of review:                                            DEGRIB1.12     
CLL                                                                        DEGRIB1.13     
CLL  Tested under compiler: cft77                                          DEGRIB1.14     
CLL  Tested under OS version: UNICOS 7                                     DEGRIB1.15     
CLL                                                                        DEGRIB1.16     
CLL  Code version no: 1       Date: 9 September 1994                       DEGRIB1.17     
CLL                                                                        DEGRIB1.18     
CLL  Modification History:                                                 DEGRIB1.19     
!  4.5  19/08/98  Added DEF,UTILIO   (A Van der Wal)                       GAV0F405.103    
CLL                                                                        DEGRIB1.20     
CLL Programming standard: UM Doc Paper 3, version                          DEGRIB1.21     
CLL                                                                        DEGRIB1.22     
CLL Logucal component number:                                              DEGRIB1.23     
CLL                                                                        DEGRIB1.24     
CLL Project task:                                                          DEGRIB1.25     
CLL                                                                        DEGRIB1.26     
CLL                                                                        DEGRIB1.27     
CLL Documentation:                                                         DEGRIB1.28     
CLL   UMDP                                                                 DEGRIB1.29     
CLL                                                                        DEGRIB1.30     
CLL -------------------------------------------------------------          DEGRIB1.31     
                                                                           DEGRIB1.32     
      INTEGER                                                              DEGRIB1.33     
     &     IDIM                                                            DEGRIB1.34     
     &    ,NUM_CRAY_WORDS                                                  DEGRIB1.35     
     &    ,ILABEL(64)                                                      DEGRIB1.36     
     &    ,NUM_UNPACK_VALUES                                               DEGRIB1.37     
     &    ,LEN_FULL_WORD                                                   DEGRIB1.38     
      REAL                                                                 DEGRIB1.39     
     &     FIELD(IDIM)                                                     DEGRIB1.40     
     &    ,WORK_ARRAY(IDIM)                                                DEGRIB1.41     
     &    ,AMDI                                                            DEGRIB1.42     
                                                                           DEGRIB1.43     
      INTEGER                                                              DEGRIB1.44     
     &     LEN_VERT                                                        DEGRIB1.45     
     &    ,NUM_VERT                                                        DEGRIB1.46     
     &    ,LEN_BITMAP                                                      DEGRIB1.47     
     &    ,NUM_BITMAP                                                      DEGRIB1.48     
     &    ,LEN_Q                                                           DEGRIB1.49     
     &    ,NUM_Q                                                           DEGRIB1.50     
     &    ,WIDTH                                                           DEGRIB1.51     
     &    ,LEN_B0                                                          DEGRIB1.52     
     &    ,LEN_B1                                                          DEGRIB1.53     
     &    ,LEN_B2                                                          DEGRIB1.54     
     &    ,LEN_B3                                                          DEGRIB1.55     
     &    ,LEN_B4                                                          DEGRIB1.56     
     &    ,LEN_BR                                                          DEGRIB1.57     
     &    ,LEN_WRKI                                                        DEGRIB1.58     
     &    ,LEN_WRKI2                                                       DEGRIB1.59     
     &    ,LEN_WRKR                                                        DEGRIB1.60     
      PARAMETER (                                                          DEGRIB1.61     
     &     LEN_VERT=4                                                      DEGRIB1.62     
     &    ,LEN_Q=4                                                         DEGRIB1.63     
     &    ,LEN_B0=4                                                        DEGRIB1.64     
     &    ,LEN_B1=30                                                       DEGRIB1.65     
     &    ,LEN_B2=20                                                       DEGRIB1.66     
     &    ,LEN_B3=2                                                        DEGRIB1.67     
     &    ,LEN_B4=2                                                        DEGRIB1.68     
     &    ,LEN_BR=20                                                       DEGRIB1.69     
     &    ,LEN_WRKI=500                                                    DEGRIB1.70     
     &    ,LEN_WRKI2=1000                                                  DEGRIB1.71     
     &    ,LEN_WRKR=500)                                                   DEGRIB1.72     
      INTEGER                                                              DEGRIB1.73     
     &     QUASI(LEN_Q)                                                    DEGRIB1.74     
     &    ,BITMAP(IDIM)                                                    DEGRIB1.75     
     &    ,BLOCK0(LEN_B0)                                                  DEGRIB1.76     
     &    ,BLOCK1(LEN_B1)                                                  DEGRIB1.77     
     &    ,BLOCK2(LEN_B2)                                                  DEGRIB1.78     
     &    ,BLOCK3(LEN_B3)                                                  DEGRIB1.79     
     &    ,BLOCK4(LEN_B4)                                                  DEGRIB1.80     
     &    ,POSN(4)                                                         DEGRIB1.81     
     &    ,WORD                                                            DEGRIB1.82     
     &    ,OFF                                                             DEGRIB1.83     
     &    ,ERROR                                                           DEGRIB1.84     
     &    ,WORKINT(LEN_WRKI)                                               DEGRIB1.85     
     &    ,WORKINT2(LEN_WRKI2)                                             DEGRIB1.86     
      REAL                                                                 DEGRIB1.87     
     &     VERT_COORDS(LEN_VERT)                                           DEGRIB1.88     
     &    ,BLOCKR(LEN_BR)                                                  DEGRIB1.89     
     &    ,WORKRE(LEN_WRKR)                                                DEGRIB1.90     
                                                                           DEGRIB1.91     
      LEN_BITMAP=IDIM                                                      DEGRIB1.92     
      ERROR=6                                                              DEGRIB1.93     
      POSN(1)=0                                                            DEGRIB1.94     
      OFF=0                                                                DEGRIB1.95     
                                                                           DEGRIB1.96     
      CALL DECODE(WORK_ARRAY,WORK_ARRAY2,IDIM,NUM_UNPACK_VALUES,           DEGRIB1.97     
     1            VERT_COORDS,LEN_VERT,NUM_VERT,                           DEGRIB1.98     
     2            BITMAP,LEN_BITMAP,NUM_BITMAP,                            DEGRIB1.99     
     3            QUASI,LEN_Q,NUM_Q,                                       DEGRIB1.100    
     4            WIDTH,LEN_FULL_WORD,                                     UIE1F401.1      
     5            BLOCK0,BLOCK1,BLOCK2,BLOCK3,BLOCK4,BLOCKR,               DEGRIB1.102    
     6            FIELD,IDIM,POSN,WORD,OFF,ERROR,                          DEGRIB1.103    
     7            WORKINT,WORKINT2,WORKRE)                                 DEGRIB1.104    
                                                                           DEGRIB1.105    
      RETURN                                                               DEGRIB1.106    
      END                                                                  DEGRIB1.107    
*ENDIF                                                                     DEGRIB1.108